[ocamlformat] Upgrade to ocamlformat 0.4

Reviewed By: jvillard

Differential Revision: D7079161

fbshipit-source-id: 17b2f0c
master
Josh Berdine 7 years ago committed by Facebook Github Bot
parent 4b56e32a29
commit 3534838b73

@ -1,3 +1,3 @@
margin 100 margin 100
sparse true sparse true
version 0.3 version 0.4

@ -284,7 +284,7 @@ let log_issue err_kind err_log loc (node_id, node_key) session ltr ?linters_def_
"@\n%a@\n@?" "@\n%a@\n@?"
(Exceptions.pp_err ~node_key loc err_kind error.name error.description error.ml_loc) (Exceptions.pp_err ~node_key loc err_kind error.name error.description error.ml_loc)
() ; () ;
if err_kind <> Exceptions.Kerror then if err_kind <> Exceptions.Kerror then (
let warn_str = let warn_str =
let pp fmt = let pp fmt =
Format.fprintf fmt "%s %a" error.name.IssueType.unique_id Localise.pp_error_desc Format.fprintf fmt "%s %a" error.name.IssueType.unique_id Localise.pp_error_desc
@ -301,6 +301,6 @@ let log_issue err_kind err_log loc (node_id, node_key) session ltr ?linters_def_
| Exceptions.Kinfo | Exceptions.Kadvice | Exceptions.Klike -> | Exceptions.Kinfo | Exceptions.Kadvice | Exceptions.Klike ->
L.d_info L.d_info
in in
d warn_str ; L.d_ln () d warn_str ; L.d_ln () )
in in
if should_print_now then print_now () if should_print_now then print_now ()

@ -161,8 +161,8 @@ td.rowname { text-align:right; font-weight:bold; color:#444444; padding-right:2e
let node_text = let node_text =
let pp fmt = let pp fmt =
Format.fprintf fmt Format.fprintf fmt
"<span class='%s'>%s<span class='expansion'>node%d preds:%a succs:%a exn:%a %s%s</span></span>" "<span class='%s'>%s<span class='expansion'>node%d preds:%a succs:%a exn:%a \
style_class display_name id (Pp.seq Format.pp_print_int) preds %s%s</span></span>" style_class display_name id (Pp.seq Format.pp_print_int) preds
(Pp.seq Format.pp_print_int) succs (Pp.seq Format.pp_print_int) exn description (Pp.seq Format.pp_print_int) succs (Pp.seq Format.pp_print_int) exn description
(if not isvisited then "\nNOT VISITED" else "") (if not isvisited then "\nNOT VISITED" else "")
in in

@ -261,8 +261,8 @@ let deref_str_nil_argument_in_variadic_method pn total_args arg_number =
in in
let problem_str = let problem_str =
Printf.sprintf Printf.sprintf
"could be %s which results in a call to %s with %d arguments instead of %d (%s indicates that the last argument of this variadic %s has been reached)" "could be %s which results in a call to %s with %d arguments instead of %d (%s indicates \
nil_null that the last argument of this variadic %s has been reached)" nil_null
(Typ.Procname.to_simplified_string pn) (Typ.Procname.to_simplified_string pn)
arg_number (total_args - 1) nil_null function_method arg_number (total_args - 1) nil_null function_method
in in
@ -389,9 +389,11 @@ let desc_unsafe_guarded_by_access accessed_fld guarded_by_str loc =
in in
let msg = let msg =
Format.asprintf Format.asprintf
"The field %a is annotated with %a, but the lock %a is not held during the access to the field %s. Since the current method is non-private, it can be called from outside the current class without synchronization. Consider wrapping the access in a %s block or making the method private." "The field %a is annotated with %a, but the lock %a is not held during the access to the \
MF.pp_monospaced accessed_fld_str MF.pp_monospaced annot_str MF.pp_monospaced guarded_by_str field %s. Since the current method is non-private, it can be called from outside the \
line_info syncronized_str current class without synchronization. Consider wrapping the access in a %s block or \
making the method private." MF.pp_monospaced accessed_fld_str MF.pp_monospaced annot_str
MF.pp_monospaced guarded_by_str line_info syncronized_str
in in
{no_desc with descriptions= [msg]} {no_desc with descriptions= [msg]}
@ -403,10 +405,12 @@ let desc_fragment_retains_view fragment_typ fieldname fld_typ pname : error_desc
(format_typ fragment_typ) (format_field fieldname) (format_typ fld_typ) (format_method pname) (format_typ fragment_typ) (format_field fieldname) (format_typ fld_typ) (format_method pname)
in in
let consequences = let consequences =
"If this Fragment is placed on the back stack, a reference to this (probably dead) View will be retained." "If this Fragment is placed on the back stack, a reference to this (probably dead) View will \
be retained."
in in
let advice = let advice =
"In general, it is a good idea to initialize View's in onCreateView, then nullify them in onDestroyView." "In general, it is a good idea to initialize View's in onCreateView, then nullify them in \
onDestroyView."
in in
{no_desc with descriptions= [problem; consequences; advice]} {no_desc with descriptions= [problem; consequences; advice]}

@ -786,8 +786,8 @@ let specialize_with_block_args callee_pdesc pname_with_block_args block_args =
source_file source_file
| None -> | None ->
Logging.die InternalError Logging.die InternalError
"specialize_with_block_args ahould only be called with defined procedures, but we cannot find the captured file of procname %a" "specialize_with_block_args ahould only be called with defined procedures, but we \
Typ.Procname.pp pname cannot find the captured file of procname %a" Typ.Procname.pp pname
in in
let resolved_attributes = let resolved_attributes =
{ callee_attributes with { callee_attributes with

@ -172,75 +172,75 @@ let empty : ('f, 'f, unit, 'markers, 'markers, empty) path_matcher =
let name_cons let name_cons
: ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) path_matcher -> string : ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, _) path_matcher -> string
-> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher = -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher =
fun m name -> fun m name ->
let {on_templated_name; get_markers} = m in let {on_templated_name; get_markers} = m in
let fuzzy_name_regexp = let fuzzy_name_regexp =
name |> Str.quote |> Printf.sprintf "^%s\\(<[a-z0-9]+>\\)?$" |> Str.regexp name |> Str.quote |> Printf.sprintf "^%s\\(<[a-z0-9]+>\\)?$" |> Str.regexp
in in
let on_qual_name f qual_name = let on_qual_name f qual_name =
match QualifiedCppName.extract_last qual_name with match QualifiedCppName.extract_last qual_name with
| Some (last, rest) when Str.string_match fuzzy_name_regexp last 0 -> | Some (last, rest) when Str.string_match fuzzy_name_regexp last 0 ->
on_templated_name f (rest, []) on_templated_name f (rest, [])
| _ -> | _ ->
None None
in in
let on_objc_cpp f (objc_cpp: Typ.Procname.ObjC_Cpp.t) = let on_objc_cpp f (objc_cpp: Typ.Procname.ObjC_Cpp.t) =
if String.equal name objc_cpp.method_name then if String.equal name objc_cpp.method_name then
on_templated_name f (templated_name_of_class_name objc_cpp.class_name) on_templated_name f (templated_name_of_class_name objc_cpp.class_name)
else None else None
in in
{on_objc_cpp; on_qual_name; get_markers} {on_objc_cpp; on_qual_name; get_markers}
let all_names_cons let all_names_cons
: ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, non_empty) path_matcher : ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, non_empty) path_matcher
-> ('f_in, 'f_out, 'captured_tpes, 'markers_in, 'markers_out, non_empty) path_matcher = -> ('f_in, 'f_out, 'captured_tpes, 'markers_in, 'markers_out, non_empty) path_matcher =
fun m -> fun m ->
let {on_templated_name; get_markers; path_extra= PathNonEmpty {on_objc_cpp}} = m in let {on_templated_name; get_markers; path_extra= PathNonEmpty {on_objc_cpp}} = m in
let rec on_templated_name_rec f templated_name = let rec on_templated_name_rec f templated_name =
match on_templated_name f templated_name with match on_templated_name f templated_name with
| Some _ as some -> | Some _ as some ->
some some
| None -> | None ->
let qual_name, _template_args = templated_name in let qual_name, _template_args = templated_name in
match QualifiedCppName.extract_last qual_name with match QualifiedCppName.extract_last qual_name with
| None -> | None ->
None None
| Some (_last, rest) -> | Some (_last, rest) ->
on_templated_name_rec f (rest, []) on_templated_name_rec f (rest, [])
in in
let on_templated_name = on_templated_name_rec in let on_templated_name = on_templated_name_rec in
let on_objc_cpp f (objc_cpp: Typ.Procname.ObjC_Cpp.t) = let on_objc_cpp f (objc_cpp: Typ.Procname.ObjC_Cpp.t) =
match on_objc_cpp f objc_cpp with match on_objc_cpp f objc_cpp with
| Some _ as some -> | Some _ as some ->
some some
| None -> | None ->
on_templated_name f (templated_name_of_class_name objc_cpp.class_name) on_templated_name f (templated_name_of_class_name objc_cpp.class_name)
in in
{on_templated_name; get_markers; path_extra= PathNonEmpty {on_objc_cpp}} {on_templated_name; get_markers; path_extra= PathNonEmpty {on_objc_cpp}}
let templ_begin let templ_begin
: ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher : ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out) name_matcher
-> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, accept_more) templ_matcher = -> ('f_in, 'f_out, 'captured_types, 'markers_in, 'markers_out, accept_more) templ_matcher =
fun m -> fun m ->
let {on_objc_cpp; on_qual_name; get_markers} = m in let {on_objc_cpp; on_qual_name; get_markers} = m in
let on_templated_name f (qual_name, template_args) = let on_templated_name f (qual_name, template_args) =
match on_qual_name f qual_name with match on_qual_name f qual_name with
| None -> | None ->
None None
| Some (f, captured_types) -> | Some (f, captured_types) ->
Some (f, captured_types, template_args) Some (f, captured_types, template_args)
in in
let on_objc_cpp f (objc_cpp: Typ.Procname.ObjC_Cpp.t) = let on_objc_cpp f (objc_cpp: Typ.Procname.ObjC_Cpp.t) =
match on_objc_cpp f objc_cpp with match on_objc_cpp f objc_cpp with
| None -> | None ->
None None
| Some (f, captured_types) -> | Some (f, captured_types) ->
let template_args = template_args_of_template_spec_info objc_cpp.template_args in let template_args = template_args_of_template_spec_info objc_cpp.template_args in
Some (f, captured_types, template_args) Some (f, captured_types, template_args)
in in
{on_objc_cpp; on_templated_name; get_markers} {on_objc_cpp; on_templated_name; get_markers}
let templ_cons let templ_cons
@ -260,15 +260,15 @@ let templ_cons
, 'lc ) , 'lc )
template_arg template_arg
-> ('f_in, 'f_out, 'captured_types_out, 'markers_in, 'markers_out, 'lc) templ_matcher = -> ('f_in, 'f_out, 'captured_types_out, 'markers_in, 'markers_out, 'lc) templ_matcher =
fun m template_arg -> fun m template_arg ->
let {on_objc_cpp; on_templated_name; get_markers} = m in let {on_objc_cpp; on_templated_name; get_markers} = m in
let {eat_template_arg; add_marker} = template_arg in let {eat_template_arg; add_marker} = template_arg in
let get_markers m = get_markers (add_marker m) in let get_markers m = get_markers (add_marker m) in
let on_templated_name f templated_name = let on_templated_name f templated_name =
on_templated_name f templated_name |> Option.bind ~f:eat_template_arg on_templated_name f templated_name |> Option.bind ~f:eat_template_arg
in in
let on_objc_cpp f objc_cpp = on_objc_cpp f objc_cpp |> Option.bind ~f:eat_template_arg in let on_objc_cpp f objc_cpp = on_objc_cpp f objc_cpp |> Option.bind ~f:eat_template_arg in
{on_objc_cpp; on_templated_name; get_markers} {on_objc_cpp; on_templated_name; get_markers}
let templ_end let templ_end
@ -307,24 +307,24 @@ let args_cons
: ('f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers) args_matcher : ('f_in, 'f_proc_out, 'f_interm, 'captured_types, 'markers) args_matcher
-> ('f_interm, 'f_out, 'captured_types, 'markers) func_arg -> ('f_interm, 'f_out, 'captured_types, 'markers) func_arg
-> ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher = -> ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher =
fun m func_arg -> fun m func_arg ->
let {on_proc; on_args; markers} = m in let {on_proc; on_args; markers} = m in
let {marker_static_checker; eat_func_arg} = func_arg in let {marker_static_checker; eat_func_arg} = func_arg in
assert (marker_static_checker markers) ; assert (marker_static_checker markers) ;
let on_args capt f_args = on_args capt f_args |> Option.bind ~f:(eat_func_arg capt) in let on_args capt f_args = on_args capt f_args |> Option.bind ~f:(eat_func_arg capt) in
{on_proc; on_args; markers} {on_proc; on_args; markers}
let args_end let args_end
: ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher : ('f_in, 'f_proc_out, 'f_out, 'captured_types, 'markers) args_matcher
-> ('f_proc_out, 'f_out, 'captured_types) func_args_end -> ('f_in, 'f_out) all_args_matcher = -> ('f_proc_out, 'f_out, 'captured_types) func_args_end -> ('f_in, 'f_out) all_args_matcher =
fun m func_args_end -> fun m func_args_end ->
let {on_proc= {on_c; on_objc_cpp}; on_args} = m in let {on_proc= {on_c; on_objc_cpp}; on_args} = m in
let on_c f c args = on_c f c |> pre_bind_opt ~f:(func_args_end ~on_args args) in let on_c f c args = on_c f c |> pre_bind_opt ~f:(func_args_end ~on_args args) in
let on_objc_cpp f objc_cpp args = let on_objc_cpp f objc_cpp args =
on_objc_cpp f objc_cpp |> pre_bind_opt ~f:(func_args_end ~on_args args) on_objc_cpp f objc_cpp |> pre_bind_opt ~f:(func_args_end ~on_args args)
in in
{on_c; on_objc_cpp} {on_c; on_objc_cpp}
module type Common = sig module type Common = sig
@ -460,17 +460,17 @@ module Common = struct
, 'marker * 'markers , 'marker * 'markers
, accept_more ) , accept_more )
template_arg = template_arg =
fun marker -> fun marker ->
let eat_template_arg (f, captured_types, template_args) = let eat_template_arg (f, captured_types, template_args) =
match template_args with match template_args with
| (Typ.TType ty) :: rest -> | (Typ.TType ty) :: rest ->
let captured_types () = (ty, captured_types ()) in let captured_types () = (ty, captured_types ()) in
Some (f ty, captured_types, rest) Some (f ty, captured_types, rest)
| _ -> | _ ->
None None
in in
let add_marker capture_markers = (marker, capture_markers) in let add_marker capture_markers = (marker, capture_markers) in
{eat_template_arg; add_marker} {eat_template_arg; add_marker}
(** Captures an int *) (** Captures an int *)
@ -540,46 +540,46 @@ module Procname = struct
include Common include Common
let make_matcher : ('f_in, 'f_out) all_args_matcher -> 'f_in -> 'f_out matcher = let make_matcher : ('f_in, 'f_out) all_args_matcher -> 'f_in -> 'f_out matcher =
fun m f -> fun m f ->
let {on_c; on_objc_cpp} : (_, _) all_args_matcher = m in let {on_c; on_objc_cpp} : (_, _) all_args_matcher = m in
let on_objc_cpp objc_cpp args = let on_objc_cpp objc_cpp args =
match on_objc_cpp f objc_cpp args with match on_objc_cpp f objc_cpp args with
| DoesNotMatch -> | DoesNotMatch ->
None None
| Matches res -> | Matches res ->
Some res Some res
| RetryWith {on_objc_cpp} -> | RetryWith {on_objc_cpp} ->
on_objc_cpp objc_cpp args on_objc_cpp objc_cpp args
in in
let on_c c args = let on_c c args =
match on_c f c args with match on_c f c args with
| DoesNotMatch -> | DoesNotMatch ->
None None
| Matches res -> | Matches res ->
Some res Some res
| RetryWith {on_c} -> | RetryWith {on_c} ->
on_c c args on_c c args
in in
{on_objc_cpp; on_c} {on_objc_cpp; on_c}
(** Simple implementation of a dispatcher, could be optimized later *) (** Simple implementation of a dispatcher, could be optimized later *)
let make_dispatcher : 'f matcher list -> 'f dispatcher = let make_dispatcher : 'f matcher list -> 'f dispatcher =
fun matchers -> fun matchers ->
let on_objc_cpp objc_cpp args = let on_objc_cpp objc_cpp args =
List.find_map matchers ~f:(fun (matcher: _ matcher) -> matcher.on_objc_cpp objc_cpp args) List.find_map matchers ~f:(fun (matcher: _ matcher) -> matcher.on_objc_cpp objc_cpp args)
in in
let on_c c args = let on_c c args =
List.find_map matchers ~f:(fun (matcher: _ matcher) -> matcher.on_c c args) List.find_map matchers ~f:(fun (matcher: _ matcher) -> matcher.on_c c args)
in in
fun procname args -> fun procname args ->
match procname with match procname with
| ObjC_Cpp objc_cpp -> | ObjC_Cpp objc_cpp ->
on_objc_cpp objc_cpp args on_objc_cpp objc_cpp args
| C c -> | C c ->
on_c c args on_c c args
| _ -> | _ ->
None None
(* Function args *) (* Function args *)
@ -595,10 +595,10 @@ module Procname = struct
let mk_match_typ_nth let mk_match_typ_nth
: ('markers -> 'marker) -> ('captured_types -> 'marker mtyp) -> 'marker : ('markers -> 'marker) -> ('captured_types -> 'marker mtyp) -> 'marker
-> ('captured_types, 'markers) one_arg_matcher = -> ('captured_types, 'markers) one_arg_matcher =
fun get_m get_c marker -> fun get_m get_c marker ->
let marker_static_checker markers = Polymorphic_compare.( = ) marker (get_m markers) in let marker_static_checker markers = Polymorphic_compare.( = ) marker (get_m markers) in
let match_arg capt arg = Typ.equal (FuncArg.typ arg) (get_c capt) in let match_arg capt arg = Typ.equal (FuncArg.typ arg) (get_c capt) in
{match_arg; marker_static_checker} {match_arg; marker_static_checker}
(** Matches first captured type *) (** Matches first captured type *)
@ -622,19 +622,19 @@ module Procname = struct
(** Matches the type matched by the given path_matcher *) (** Matches the type matched by the given path_matcher *)
let match_typ : (_, _, unit, unit, unit, non_empty) path_matcher -> (_, _) one_arg_matcher = let match_typ : (_, _, unit, unit, unit, non_empty) path_matcher -> (_, _) one_arg_matcher =
fun m -> fun m ->
let {on_templated_name} : (_, _, unit, unit, unit, non_empty) path_matcher = m in let {on_templated_name} : (_, _, unit, unit, unit, non_empty) path_matcher = m in
let rec match_typ typ = let rec match_typ typ =
match typ with match typ with
| {Typ.desc= Tstruct name} -> | {Typ.desc= Tstruct name} ->
name |> templated_name_of_class_name |> on_templated_name () |> Option.is_some name |> templated_name_of_class_name |> on_templated_name () |> Option.is_some
| {Typ.desc= Tptr (typ, _ptr_kind)} -> | {Typ.desc= Tptr (typ, _ptr_kind)} ->
match_typ typ match_typ typ
| _ -> | _ ->
false false
in in
let match_arg _capt arg = match_typ (FuncArg.typ arg) in let match_arg _capt arg = match_typ (FuncArg.typ arg) in
{match_arg; marker_static_checker= no_marker_checker} {match_arg; marker_static_checker= no_marker_checker}
(* Function argument capture *) (* Function argument capture *)
@ -674,21 +674,21 @@ module Procname = struct
let make_arg let make_arg
: ('arg_in, 'arg_out, 'f_in, 'f_out) arg_preparer : ('arg_in, 'arg_out, 'f_in, 'f_out) arg_preparer
-> ('arg_in, 'arg_out, 'f_in, 'f_out, _, _) one_arg -> ('f_in, 'f_out, _, _) func_arg = -> ('arg_in, 'arg_out, 'f_in, 'f_out, _, _) one_arg -> ('f_in, 'f_out, _, _) func_arg =
fun arg_preparer one_arg -> fun arg_preparer one_arg ->
let {on_empty; wrapper} = arg_preparer in let {on_empty; wrapper} = arg_preparer in
let {one_arg_matcher; capture} = one_arg in let {one_arg_matcher; capture} = one_arg in
let {match_arg; marker_static_checker} = one_arg_matcher in let {match_arg; marker_static_checker} = one_arg_matcher in
let {get_captured_value; do_capture} = capture in let {get_captured_value; do_capture} = capture in
let eat_func_arg capt (f, args) = let eat_func_arg capt (f, args) =
match args with match args with
| [] -> | [] ->
on_empty do_capture f on_empty do_capture f
| arg :: rest when match_arg capt arg -> | arg :: rest when match_arg capt arg ->
Some (arg |> get_captured_value |> wrapper |> do_capture f, rest) Some (arg |> get_captured_value |> wrapper |> do_capture f, rest)
| _ -> | _ ->
None None
in in
{eat_func_arg; marker_static_checker} {eat_func_arg; marker_static_checker}
let any_arg : (unit, _, 'f, 'f, _, _) one_arg = let any_arg : (unit, _, 'f, 'f, _, _) one_arg =
@ -708,15 +708,15 @@ module Procname = struct
let capt_exp_of_typ m = {one_arg_matcher= match_typ (m <...>! ()); capture= capture_arg_exp} let capt_exp_of_typ m = {one_arg_matcher= match_typ (m <...>! ()); capture= capture_arg_exp}
let typ1 : 'marker -> (unit, _, 'f, 'f, _, _) one_arg = let typ1 : 'marker -> (unit, _, 'f, 'f, _, _) one_arg =
fun m -> {one_arg_matcher= match_typ1 m; capture= no_capture} fun m -> {one_arg_matcher= match_typ1 m; capture= no_capture}
let typ2 : 'marker -> (unit, _, 'f, 'f, _, _) one_arg = let typ2 : 'marker -> (unit, _, 'f, 'f, _, _) one_arg =
fun m -> {one_arg_matcher= match_typ2 m; capture= no_capture} fun m -> {one_arg_matcher= match_typ2 m; capture= no_capture}
let typ3 : 'marker -> (unit, _, 'f, 'f, _, _) one_arg = let typ3 : 'marker -> (unit, _, 'f, 'f, _, _) one_arg =
fun m -> {one_arg_matcher= match_typ3 m; capture= no_capture} fun m -> {one_arg_matcher= match_typ3 m; capture= no_capture}
(* Function args end *) (* Function args end *)
@ -728,7 +728,7 @@ module Procname = struct
(** Matches any function arguments *) (** Matches any function arguments *)
let any_func_args : (_, _, _) func_args_end = let any_func_args : (_, _, _) func_args_end =
fun ~on_args args (f, capt) -> on_args capt (f, args) |> pre_map_opt ~f:fst fun ~on_args args (f, capt) -> on_args capt (f, args) |> pre_map_opt ~f:fst
(** If [func_args_end1] does not match, use [func_args_end2] *) (** If [func_args_end1] does not match, use [func_args_end2] *)
@ -736,23 +736,23 @@ module Procname = struct
: ('f_in, 'f_out, 'captured_types) func_args_end : ('f_in, 'f_out, 'captured_types) func_args_end
-> ('f_in, 'f_out, 'captured_types) func_args_end -> ('f_in, 'f_out, 'captured_types) func_args_end
-> ('f_in, 'f_out, 'captured_types) func_args_end = -> ('f_in, 'f_out, 'captured_types) func_args_end =
fun func_args_end1 func_args_end2 ~on_args args f_capt -> fun func_args_end1 func_args_end2 ~on_args args f_capt ->
match func_args_end1 ~on_args args f_capt with match func_args_end1 ~on_args args f_capt with
| DoesNotMatch -> | DoesNotMatch ->
func_args_end2 ~on_args args f_capt func_args_end2 ~on_args args f_capt
| otherwise -> | otherwise ->
otherwise otherwise
(** Retries matching with another matcher *) (** Retries matching with another matcher *)
let args_end_retry : _ matcher -> (_, _, _) func_args_end = let args_end_retry : _ matcher -> (_, _, _) func_args_end =
fun m ~on_args:_ _args _f_capt -> RetryWith m fun m ~on_args:_ _args _f_capt -> RetryWith m
(** Retries matching with another matcher if the function does not have the (** Retries matching with another matcher if the function does not have the
exact number/types of args *) exact number/types of args *)
let exact_args_or_retry : 'f matcher -> (_, _, _) func_args_end = let exact_args_or_retry : 'f matcher -> (_, _, _) func_args_end =
fun m -> alternative_args_end no_args_left (args_end_retry m) fun m -> alternative_args_end no_args_left (args_end_retry m)
let wrong_args_internal_error : _ matcher = let wrong_args_internal_error : _ matcher =
@ -816,22 +816,22 @@ module TypName = struct
let make_matcher let make_matcher
: ('f_in, 'f_out, _, _, _, non_empty) path_matcher -> 'f_in -> 'f_out typ_matcher = : ('f_in, 'f_out, _, _, _, non_empty) path_matcher -> 'f_in -> 'f_out typ_matcher =
fun m f -> fun m f ->
let {on_templated_name} : ('f_in, 'f_out, _, _, _, non_empty) path_matcher = m in let {on_templated_name} : ('f_in, 'f_out, _, _, _, non_empty) path_matcher = m in
let on_templated_name templated_name = let on_templated_name templated_name =
templated_name |> on_templated_name f |> Option.map ~f:fst templated_name |> on_templated_name f |> Option.map ~f:fst
in in
{on_templated_name} {on_templated_name}
let make_dispatcher : 'f typ_matcher list -> 'f typ_dispatcher = let make_dispatcher : 'f typ_matcher list -> 'f typ_dispatcher =
fun matchers typname -> fun matchers typname ->
match templated_name_of_class_name typname with match templated_name_of_class_name typname with
| exception DoNotHandleJavaYet -> | exception DoNotHandleJavaYet ->
None None
| templated_name -> | templated_name ->
List.find_map matchers ~f:(fun (matcher: _ typ_matcher) -> List.find_map matchers ~f:(fun (matcher: _ typ_matcher) ->
matcher.on_templated_name templated_name ) matcher.on_templated_name templated_name )
let ( &-->! ) path_matcher f = make_matcher path_matcher f let ( &-->! ) path_matcher f = make_matcher path_matcher f

@ -96,11 +96,11 @@ let load_global () : t option =
let store_to_filename tenv tenv_filename = let store_to_filename tenv tenv_filename =
Serialization.write_to_file tenv_serializer tenv_filename ~data:tenv ; Serialization.write_to_file tenv_serializer tenv_filename ~data:tenv ;
if Config.debug_mode then if Config.debug_mode then (
let debug_filename = DB.filename_to_string (DB.filename_add_suffix tenv_filename ".debug") in let debug_filename = DB.filename_to_string (DB.filename_add_suffix tenv_filename ".debug") in
let out_channel = Out_channel.create debug_filename in let out_channel = Out_channel.create debug_filename in
let fmt = Format.formatter_of_out_channel out_channel in let fmt = Format.formatter_of_out_channel out_channel in
Format.fprintf fmt "%a" pp tenv ; Out_channel.close out_channel Format.fprintf fmt "%a" pp tenv ; Out_channel.close out_channel )
let store source_file tenv = tenv_filename_of_source_file source_file |> store_to_filename tenv let store source_file tenv = tenv_filename_of_source_file source_file |> store_to_filename tenv

@ -1248,8 +1248,15 @@ module Struct = struct
if Config.debug_mode then if Config.debug_mode then
(* change false to true to print the details of struct *) (* change false to true to print the details of struct *)
F.fprintf f F.fprintf f
"%a @\n\tfields: {%a@\n\t}@\n\tsupers: {%a@\n\t}@\n\tmethods: {%a@\n\t}@\n\tannots: {%a@\n\t}" "%a @\n\
Name.pp name \tfields: {%a@\n\
\t}@\n\
\tsupers: {%a@\n\
\t}@\n\
\tmethods: {%a@\n\
\t}@\n\
\tannots: {%a@\n\
\t}" Name.pp name
(Pp.seq (pp_field pe)) (Pp.seq (pp_field pe))
fields fields
(Pp.seq (fun f n -> F.fprintf f "@\n\t\t%a" Name.pp n)) (Pp.seq (fun f n -> F.fprintf f "@\n\t\t%a" Name.pp n))

@ -78,19 +78,19 @@ struct
let instr_ids = match CFG.instr_ids node with [] -> [(Sil.skip_instr, None)] | l -> l in let instr_ids = match CFG.instr_ids node with [] -> [(Sil.skip_instr, None)] | l -> l in
if debug then NodePrinter.start_session (CFG.underlying_node node) ; if debug then NodePrinter.start_session (CFG.underlying_node node) ;
let astate_post, inv_map_post = List.fold ~f:compute_post ~init:(pre, inv_map) instr_ids in let astate_post, inv_map_post = List.fold ~f:compute_post ~init:(pre, inv_map) instr_ids in
( if debug then if debug then (
let instrs = List.map ~f:fst instr_ids in let instrs = List.map ~f:fst instr_ids in
L.d_strln L.d_strln
(Format.asprintf "PRE: %a@.INSTRS: %aPOST: %a@." Domain.pp pre (Format.asprintf "PRE: %a@.INSTRS: %aPOST: %a@." Domain.pp pre
(Sil.pp_instr_list Pp.(html Green)) (Sil.pp_instr_list Pp.(html Green))
instrs Domain.pp astate_post) ; instrs Domain.pp astate_post) ;
NodePrinter.finish_session (CFG.underlying_node node) ) ; NodePrinter.finish_session (CFG.underlying_node node) ) ;
let inv_map'' = let inv_map'' =
InvariantMap.add node_id {pre; post= astate_post; visit_count} inv_map_post InvariantMap.add node_id {pre; post= astate_post; visit_count} inv_map_post
in in
(inv_map'', Scheduler.schedule_succs work_queue node) (inv_map'', Scheduler.schedule_succs work_queue node)
in in
if InvariantMap.mem node_id inv_map then if InvariantMap.mem node_id inv_map then (
let old_state = InvariantMap.find node_id inv_map in let old_state = InvariantMap.find node_id inv_map in
let widened_pre = let widened_pre =
if CFG.is_loop_head pdesc node then if CFG.is_loop_head pdesc node then
@ -102,9 +102,10 @@ struct
let visit_count' = old_state.visit_count + 1 in let visit_count' = old_state.visit_count + 1 in
if visit_count' > Config.max_widens then if visit_count' > Config.max_widens then
L.(die InternalError) L.(die InternalError)
"Exceeded max widening threshold %d while analyzing %a. Please check your widening operator or increase the threshold" "Exceeded max widening threshold %d while analyzing %a. Please check your widening \
Config.max_widens Typ.Procname.pp (Procdesc.get_proc_name pdesc) ; operator or increase the threshold" Config.max_widens Typ.Procname.pp
update_inv_map widened_pre visit_count' (Procdesc.get_proc_name pdesc) ;
update_inv_map widened_pre visit_count' )
else else
(* first time visiting this node *) (* first time visiting this node *)
let visit_count = 1 in let visit_count = 1 in

@ -30,13 +30,13 @@ struct
type extras = TransferFunctions.extras type extras = TransferFunctions.extras
let pp_pre_post pre post hil_instr node = let pp_pre_post pre post hil_instr node =
if Config.write_html then if Config.write_html then (
let underyling_node = CFG.underlying_node node in let underyling_node = CFG.underlying_node node in
NodePrinter.start_session underyling_node ; NodePrinter.start_session underyling_node ;
L.d_strln L.d_strln
(Format.asprintf "PRE: %a@.INSTR: %a@.POST: %a@." TransferFunctions.Domain.pp pre (Format.asprintf "PRE: %a@.INSTR: %a@.POST: %a@." TransferFunctions.Domain.pp pre
HilInstr.pp hil_instr TransferFunctions.Domain.pp post) ; HilInstr.pp hil_instr TransferFunctions.Domain.pp post) ;
NodePrinter.finish_session underyling_node NodePrinter.finish_session underyling_node )
let is_java_unlock pname actuals = let is_java_unlock pname actuals =

@ -47,9 +47,9 @@ module FileRenamings = struct
raise (Yojson.Json_error "not a record") raise (Yojson.Json_error "not a record")
with Yojson.Json_error err -> with Yojson.Json_error err ->
L.(die UserError) L.(die UserError)
"Error parsing file renamings: %s@\nExpected JSON object of the following form: '%s', but instead got: '%s'" "Error parsing file renamings: %s@\n\
err "{\"current\": \"aaa.java\", \"previous\": \"BBB.java\"}" Expected JSON object of the following form: '%s', but instead got: '%s'" err
(Yojson.Basic.to_string assoc) "{\"current\": \"aaa.java\", \"previous\": \"BBB.java\"}" (Yojson.Basic.to_string assoc)
in in
match j with match j with
| `List json_renamings -> | `List json_renamings ->

@ -226,7 +226,7 @@ module IssuesJson = struct
if key.in_footprint && error_filter source_file key.err_desc key.err_name if key.in_footprint && error_filter source_file key.err_desc key.err_name
&& should_report_source_file && should_report_source_file
&& should_report key.err_kind key.err_name key.err_desc err_data.err_class && should_report key.err_kind key.err_name key.err_desc err_data.err_class
then then (
let kind = Exceptions.err_kind_string key.err_kind in let kind = Exceptions.err_kind_string key.err_kind in
let bug_type = key.err_name.IssueType.unique_id in let bug_type = key.err_name.IssueType.unique_id in
let file = SourceFile.to_string source_file in let file = SourceFile.to_string source_file in
@ -278,7 +278,7 @@ module IssuesJson = struct
; access= err_data.access } ; access= err_data.access }
in in
if not !is_first_item then pp "," else is_first_item := false ; if not !is_first_item then pp "," else is_first_item := false ;
pp "%s@?" (Jsonbug_j.string_of_jsonbug bug) pp "%s@?" (Jsonbug_j.string_of_jsonbug bug) )
(** Write bug report in JSON format *) (** Write bug report in JSON format *)

@ -191,11 +191,11 @@ let get_retain_cycles hpred tenv prop_ =
let exn_retain_cycle tenv hpred cycle = let exn_retain_cycle tenv hpred cycle =
let retain_cycle = desc_retain_cycle tenv cycle in let retain_cycle = desc_retain_cycle tenv cycle in
let cycle_dotty = Format.asprintf "%a" RetainCyclesType.pp_dotty cycle in let cycle_dotty = Format.asprintf "%a" RetainCyclesType.pp_dotty cycle in
( if Config.debug_mode then if Config.debug_mode then (
let rc_dotty_dir = Filename.concat Config.results_dir Config.retain_cycle_dotty_dir in let rc_dotty_dir = Filename.concat Config.results_dir Config.retain_cycle_dotty_dir in
Utils.create_dir rc_dotty_dir ; Utils.create_dir rc_dotty_dir ;
let rc_dotty_file = Filename.temp_file ~in_dir:rc_dotty_dir "rc" ".dot" in let rc_dotty_file = Filename.temp_file ~in_dir:rc_dotty_dir "rc" ".dot" in
RetainCyclesType.write_dotty_to_file rc_dotty_file cycle ) ; RetainCyclesType.write_dotty_to_file rc_dotty_file cycle ) ;
let desc = Localise.desc_retain_cycle retain_cycle (State.get_loc ()) (Some cycle_dotty) in let desc = Localise.desc_retain_cycle retain_cycle (State.get_loc ()) (Some cycle_dotty) in
Exceptions.Retain_cycle (hpred, desc, __POS__) Exceptions.Retain_cycle (hpred, desc, __POS__)

@ -1039,7 +1039,7 @@ let check_junk ?original_prop pname tenv prop =
List.rev sigma_done List.rev sigma_done
| hpred :: sigma_todo' -> | hpred :: sigma_todo' ->
let entries = Sil.hpred_entries hpred in let entries = Sil.hpred_entries hpred in
if should_remove_hpred entries then if should_remove_hpred entries then (
let part = if fp_part then "footprint" else "normal" in let part = if fp_part then "footprint" else "normal" in
L.d_strln (".... Prop with garbage in " ^ part ^ " part ....") ; L.d_strln (".... Prop with garbage in " ^ part ^ " part ....") ;
L.d_increase_indent 1 ; L.d_increase_indent 1 ;
@ -1159,7 +1159,7 @@ let check_junk ?original_prop pname tenv prop =
leaks_reported := alloc_attribute :: !leaks_reported ) leaks_reported := alloc_attribute :: !leaks_reported )
in in
if not ignore_leak then report_leak () ; if not ignore_leak then report_leak () ;
remove_junk_recursive sigma_done sigma_todo' remove_junk_recursive sigma_done sigma_todo' )
else remove_junk_recursive (hpred :: sigma_done) sigma_todo' else remove_junk_recursive (hpred :: sigma_done) sigma_todo'
in in
remove_junk_recursive [] sigma remove_junk_recursive [] sigma

@ -249,7 +249,7 @@ module CheckJoinPre : InfoLossCheckerSig = struct
List.length es >= 1 List.length es >= 1
| Exp.Var _ -> | Exp.Var _ ->
if Int.equal Config.join_cond 0 then List.exists ~f:(Exp.equal Exp.zero) es if Int.equal Config.join_cond 0 then List.exists ~f:(Exp.equal Exp.zero) es
else if Dangling.check side e then else if Dangling.check side e then (
let r = List.exists ~f:(fun e' -> not (Dangling.check side_op e')) es in let r = List.exists ~f:(fun e' -> not (Dangling.check side_op e')) es in
if r then ( if r then (
L.d_str ".... Dangling Check (dang e:" ; L.d_str ".... Dangling Check (dang e:" ;
@ -258,7 +258,7 @@ module CheckJoinPre : InfoLossCheckerSig = struct
Sil.d_exp_list es ; Sil.d_exp_list es ;
L.d_strln ") ...." ; L.d_strln ") ...." ;
L.d_ln () ) ; L.d_ln () ) ;
r r )
else else
let r = List.exists ~f:(Dangling.check side_op) es in let r = List.exists ~f:(Dangling.check side_op) es in
if r then ( if r then (

@ -112,11 +112,11 @@ let print_stack_info = ref false
let strip_special_chars b = let strip_special_chars b =
let b = Bytes.of_string b in let b = Bytes.of_string b in
let replace st c c' = let replace st c c' =
if Bytes.contains st c then if Bytes.contains st c then (
let idx = String.index_exn (Bytes.to_string st) c in let idx = String.index_exn (Bytes.to_string st) c in
try Bytes.set st idx c' ; st with Invalid_argument _ -> try Bytes.set st idx c' ; st with Invalid_argument _ ->
L.internal_error "@\n@\nstrip_special_chars: Invalid argument!@\n@." ; L.internal_error "@\n@\nstrip_special_chars: Invalid argument!@\n@." ;
assert false assert false )
else st else st
in in
let s0 = replace b '(' 'B' in let s0 = replace b '(' 'B' in

@ -1150,11 +1150,11 @@ let explain_dereference_as_caller_expression proc_name tenv ?(use_buckets= false
if Pvar.is_global pv then if Pvar.is_global pv then
let dexp = exp_lv_dexp tenv node (Exp.Lvar pv) in let dexp = exp_lv_dexp tenv node (Exp.Lvar pv) in
create_dereference_desc proc_name tenv ~use_buckets dexp deref_str actual_pre loc create_dereference_desc proc_name tenv ~use_buckets dexp deref_str actual_pre loc
else if Pvar.is_callee pv then else if Pvar.is_callee pv then (
let position = find_formal_param_number pv_name in let position = find_formal_param_number pv_name in
if verbose then L.d_strln ("parameter number: " ^ string_of_int position) ; if verbose then L.d_strln ("parameter number: " ^ string_of_int position) ;
explain_nth_function_parameter proc_name tenv use_buckets deref_str actual_pre position explain_nth_function_parameter proc_name tenv use_buckets deref_str actual_pre position
pvar_off pvar_off )
else if Attribute.has_dangling_uninit tenv spec_pre exp then else if Attribute.has_dangling_uninit tenv spec_pre exp then
Localise.desc_uninitialized_dangling_pointer_deref deref_str (Pvar.to_string pv) loc Localise.desc_uninitialized_dangling_pointer_deref deref_str (Pvar.to_string pv) loc
else Localise.no_desc else Localise.no_desc

@ -153,14 +153,14 @@ and isel_match isel1 sub vars isel2 =
| (idx1, se1') :: isel1', (idx2, se2') :: isel2' -> | (idx1, se1') :: isel1', (idx2, se2') :: isel2' ->
let idx2 = Sil.exp_sub (`Exp sub) idx2 in let idx2 = Sil.exp_sub (`Exp sub) idx2 in
let sanity_check = not (List.exists ~f:(fun id -> Sil.ident_in_exp id idx2) vars) in let sanity_check = not (List.exists ~f:(fun id -> Sil.ident_in_exp id idx2) vars) in
if not sanity_check then if not sanity_check then (
let pe = Pp.text in let pe = Pp.text in
L.internal_error "@[.... Sanity Check Failure while Matching Index-Strexps ....@\n" ; L.internal_error "@[.... Sanity Check Failure while Matching Index-Strexps ....@\n" ;
L.internal_error "@[<4> IDX1: %a, STREXP1: %a@\n" (Sil.pp_exp_printenv pe) idx1 L.internal_error "@[<4> IDX1: %a, STREXP1: %a@\n" (Sil.pp_exp_printenv pe) idx1
(Sil.pp_sexp pe) se1' ; (Sil.pp_sexp pe) se1' ;
L.internal_error "@[<4> IDX2: %a, STREXP2: %a@\n@." (Sil.pp_exp_printenv pe) idx2 L.internal_error "@[<4> IDX2: %a, STREXP2: %a@\n@." (Sil.pp_exp_printenv pe) idx2
(Sil.pp_sexp pe) se2' ; (Sil.pp_sexp pe) se2' ;
assert false assert false )
else if Exp.equal idx1 idx2 then else if Exp.equal idx1 idx2 then
match strexp_match se1' sub vars se2' with match strexp_match se1' sub vars se2' with
| None -> | None ->

@ -102,10 +102,10 @@ let should_link ~target ~target_results_dir ~stats infer_out_src infer_out_dst =
let was_copied () = let was_copied () =
let captured_src = Filename.concat infer_out_src Config.captured_dir_name in let captured_src = Filename.concat infer_out_src Config.captured_dir_name in
let captured_dst = Filename.concat infer_out_dst Config.captured_dir_name in let captured_dst = Filename.concat infer_out_dst Config.captured_dir_name in
if Sys.file_exists captured_src = `Yes && Sys.is_directory captured_src = `Yes then if Sys.file_exists captured_src = `Yes && Sys.is_directory captured_src = `Yes then (
let captured_files = Array.to_list (Sys.readdir captured_src) in let captured_files = Array.to_list (Sys.readdir captured_src) in
num_captured_files := List.length captured_files ; num_captured_files := List.length captured_files ;
List.for_all ~f:(fun file -> check_file (Filename.concat captured_dst file)) captured_files List.for_all ~f:(fun file -> check_file (Filename.concat captured_dst file)) captured_files )
else true else true
in in
let was_modified () = String.Set.mem !modified_targets target in let was_modified () = String.Set.mem !modified_targets target in

@ -205,10 +205,10 @@ end = struct
let nodes_found stats = stats.max_length > 0 in let nodes_found stats = stats.max_length > 0 in
function function
| Pstart (node, stats) -> | Pstart (node, stats) ->
if stats_is_dummy stats then if stats_is_dummy stats then (
let found = f node in let found = f node in
stats.max_length <- (if found then 1 else 0) ; stats.max_length <- (if found then 1 else 0) ;
stats.linear_num <- 1.0 stats.linear_num <- 1.0 )
| Pnode (node, _, _, path, stats, _) -> | Pnode (node, _, _, path, stats, _) ->
if stats_is_dummy stats then ( if stats_is_dummy stats then (
compute_stats do_calls f path ; compute_stats do_calls f path ;
@ -227,7 +227,7 @@ end = struct
stats.max_length <- max stats1.max_length stats2.max_length ; stats.max_length <- max stats1.max_length stats2.max_length ;
stats.linear_num <- stats1.linear_num +. stats2.linear_num ) stats.linear_num <- stats1.linear_num +. stats2.linear_num )
| Pcall (path1, _, ExecCompleted path2, stats) -> | Pcall (path1, _, ExecCompleted path2, stats) ->
if stats_is_dummy stats then if stats_is_dummy stats then (
let stats2 = let stats2 =
match do_calls with match do_calls with
| true -> | true ->
@ -244,12 +244,12 @@ end = struct
compute_stats do_calls f' path1 ; get_stats path1 compute_stats do_calls f' path1 ; get_stats path1
in in
stats.max_length <- stats1.max_length + stats2.max_length ; stats.max_length <- stats1.max_length + stats2.max_length ;
stats.linear_num <- stats1.linear_num stats.linear_num <- stats1.linear_num )
| Pcall (path, _, ExecSkipped _, stats) -> | Pcall (path, _, ExecSkipped _, stats) ->
if stats_is_dummy stats then if stats_is_dummy stats then (
let stats1 = compute_stats do_calls f path ; get_stats path in let stats1 = compute_stats do_calls f path ; get_stats path in
stats.max_length <- stats1.max_length ; stats.max_length <- stats1.max_length ;
stats.linear_num <- stats1.linear_num stats.linear_num <- stats1.linear_num )
end end
(* End of module Invariant *) (* End of module Invariant *)
@ -441,10 +441,10 @@ end = struct
F.fprintf fmt "(%a: %s)" (doit (n - 1)) path reason F.fprintf fmt "(%a: %s)" (doit (n - 1)) path reason
in in
let print_delayed () = let print_delayed () =
if not (PathMap.is_empty !delayed) then if not (PathMap.is_empty !delayed) then (
let f path num = F.fprintf fmt "P%d = %a@\n" num (doit 1) path in let f path num = F.fprintf fmt "P%d = %a@\n" num (doit 1) path in
F.fprintf fmt "where@\n" ; F.fprintf fmt "where@\n" ;
PathMap.iter f !delayed PathMap.iter f !delayed )
in in
add_delayed path ; doit 0 fmt path ; print_delayed () add_delayed path ; doit 0 fmt path ; print_delayed ()

@ -358,7 +358,7 @@ let node_finish_session node =
(** Write html file for the procedure. (** Write html file for the procedure.
The boolean indicates whether to print whole seconds only *) The boolean indicates whether to print whole seconds only *)
let write_proc_html pdesc = let write_proc_html pdesc =
if Config.write_html then if Config.write_html then (
let pname = Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
let source = (Procdesc.get_loc pdesc).file in let source = (Procdesc.get_loc pdesc).file in
let nodes = List.sort ~cmp:Procdesc.Node.compare (Procdesc.get_nodes pdesc) in let nodes = List.sort ~cmp:Procdesc.Node.compare (Procdesc.get_nodes pdesc) in
@ -386,7 +386,7 @@ let write_proc_html pdesc =
() ()
| Some summary -> | Some summary ->
Specs.pp_summary_html source Black fmt summary ; Specs.pp_summary_html source Black fmt summary ;
Io_infer.Html.close (fd, fmt) Io_infer.Html.close (fd, fmt) )
(** Creare a hash table mapping line numbers to the set of errors occurring on that line *) (** Creare a hash table mapping line numbers to the set of errors occurring on that line *)

@ -465,8 +465,9 @@ let rec create_strexp_of_type ~path tenv struct_init_mode (typ: Typ.t) len inst
-> ( -> (
if List.exists ~f:(fun (n, _) -> Typ.Name.equal n name) path then if List.exists ~f:(fun (n, _) -> Typ.Name.equal n name) path then
L.die InternalError L.die InternalError
"Ill-founded recursion in [create_strexp_of_type]: a sub-element of struct %a is also of type struct %a: %a:%a" "Ill-founded recursion in [create_strexp_of_type]: a sub-element of struct %a is also \
Typ.Name.pp name Typ.Name.pp name pp_path (List.rev path) Typ.Name.pp name ; of type struct %a: %a:%a" Typ.Name.pp name Typ.Name.pp name pp_path (List.rev path)
Typ.Name.pp name ;
match (struct_init_mode, Tenv.lookup tenv name) with match (struct_init_mode, Tenv.lookup tenv name) with
| Fld_init, Some {fields} -> | Fld_init, Some {fields} ->
(* pass len as an accumulator, so that it is passed to create_strexp_of_type for the last (* pass len as an accumulator, so that it is passed to create_strexp_of_type for the last
@ -2284,7 +2285,6 @@ let from_pi pi = set prop_emp ~pi
let from_sigma sigma = set prop_emp ~sigma let from_sigma sigma = set prop_emp ~sigma
(** {2 Prop iterators} *) (** {2 Prop iterators} *)
(** Iterator state over sigma. *) (** Iterator state over sigma. *)

@ -876,27 +876,27 @@ let get_smt_key a p =
let check_atom tenv prop a0 = let check_atom tenv prop a0 =
let a = Prop.atom_normalize_prop tenv prop a0 in let a = Prop.atom_normalize_prop tenv prop a0 in
let prop_no_fp = Prop.set prop ~pi_fp:[] ~sigma_fp:[] in let prop_no_fp = Prop.set prop ~pi_fp:[] ~sigma_fp:[] in
( if Config.smt_output then if Config.smt_output then (
let key = get_smt_key a prop_no_fp in let key = get_smt_key a prop_no_fp in
let key_filename = let key_filename =
let source = (State.get_loc ()).file in let source = (State.get_loc ()).file in
DB.Results_dir.path_to_filename (DB.Results_dir.Abs_source_dir source) [key ^ ".cns"] DB.Results_dir.path_to_filename (DB.Results_dir.Abs_source_dir source) [key ^ ".cns"]
in in
let outc = Out_channel.create (DB.filename_to_string key_filename) in let outc = Out_channel.create (DB.filename_to_string key_filename) in
let fmt = F.formatter_of_out_channel outc in let fmt = F.formatter_of_out_channel outc in
L.d_str ("ID: " ^ key) ; L.d_str ("ID: " ^ key) ;
L.d_ln () ; L.d_ln () ;
L.d_str "CHECK_ATOM_BOUND: " ; L.d_str "CHECK_ATOM_BOUND: " ;
Sil.d_atom a ; Sil.d_atom a ;
L.d_ln () ; L.d_ln () ;
L.d_str "WHERE:" ; L.d_str "WHERE:" ;
L.d_ln () ; L.d_ln () ;
Prop.d_prop prop_no_fp ; Prop.d_prop prop_no_fp ;
L.d_ln () ; L.d_ln () ;
L.d_ln () ; L.d_ln () ;
F.fprintf fmt "ID: %s @\nCHECK_ATOM_BOUND: %a@\nWHERE:@\n%a" key (Sil.pp_atom Pp.text) a F.fprintf fmt "ID: %s @\nCHECK_ATOM_BOUND: %a@\nWHERE:@\n%a" key (Sil.pp_atom Pp.text) a
(Prop.pp_prop Pp.text) prop_no_fp ; (Prop.pp_prop Pp.text) prop_no_fp ;
Out_channel.close outc ) ; Out_channel.close outc ) ;
match a with match a with
| Sil.Aeq (Exp.BinOp (Binop.Le, e1, e2), Exp.Const Const.Cint i) when IntLit.isone i -> | Sil.Aeq (Exp.BinOp (Binop.Le, e1, e2), Exp.Const Const.Cint i) when IntLit.isone i ->
check_le_normalized tenv prop e1 e2 check_le_normalized tenv prop e1 e2

@ -181,13 +181,13 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp
| Tint _, _ | Tfloat _, _ | Tvoid, _ | Tfun _, _ | Tptr _, _ | TVar _, _ -> | Tint _, _ | Tfloat _, _ | Tvoid, _ | Tfun _, _ | Tptr _, _ | TVar _, _ ->
fail t off __POS__ fail t off __POS__
in in
( if Config.trace_rearrange then if Config.trace_rearrange then (
let _, se, _ = res in let _, se, _ = res in
L.d_strln "exiting create_struct_values, returning" ; L.d_strln "exiting create_struct_values, returning" ;
Sil.d_sexp se ; Sil.d_sexp se ;
L.d_decrease_indent 1 ; L.d_decrease_indent 1 ;
L.d_ln () ; L.d_ln () ;
L.d_ln () ) ; L.d_ln () ) ;
res res
@ -327,7 +327,7 @@ and array_case_analysis_index pname tenv orig_prop footprint_part kind max_stamp
let array_default = Sil.Earray (array_len, array_cont, inst_arr) in let array_default = Sil.Earray (array_len, array_cont, inst_arr) in
let typ_default = Typ.mk_array ~default:typ_array typ_cont ?length:typ_array_len in let typ_default = Typ.mk_array ~default:typ_array typ_cont ?length:typ_array_len in
[([], array_default, typ_default)] [([], array_default, typ_default)]
else if !Config.footprint then else if !Config.footprint then (
let atoms, elem_se, elem_typ = let atoms, elem_se, elem_typ =
create_struct_values pname tenv orig_prop footprint_part kind max_stamp typ_cont off inst create_struct_values pname tenv orig_prop footprint_part kind max_stamp typ_cont off inst
in in
@ -337,7 +337,7 @@ and array_case_analysis_index pname tenv orig_prop footprint_part kind max_stamp
in in
let array_new = Sil.Earray (array_len, cont_new, inst_arr) in let array_new = Sil.Earray (array_len, cont_new, inst_arr) in
let typ_new = Typ.mk_array ~default:typ_array elem_typ ?length:typ_array_len in let typ_new = Typ.mk_array ~default:typ_array elem_typ ?length:typ_array_len in
[(atoms, array_new, typ_new)] [(atoms, array_new, typ_new)] )
else else
let res_new = let res_new =
if array_is_full then [] if array_is_full then []

@ -68,8 +68,9 @@ let log_issue_deprecated ?(store_summary= false) err_kind proc_name ?loc ?node_i
Specs.store_summary summary Specs.store_summary summary
| None -> | None ->
L.(die InternalError) L.(die InternalError)
"Trying to report error on procedure %a, but cannot because no summary exists for this procedure. Did you mean to log the error on the caller of %a instead?" "Trying to report error on procedure %a, but cannot because no summary exists for this \
Typ.Procname.pp proc_name Typ.Procname.pp proc_name procedure. Did you mean to log the error on the caller of %a instead?" Typ.Procname.pp
proc_name Typ.Procname.pp proc_name
let log_error = log_issue_from_summary Exceptions.Kerror let log_error = log_issue_from_summary Exceptions.Kerror

@ -791,7 +791,7 @@ let handle_objc_instance_method_call_or_skip pdesc tenv actual_pars path callee_
| _ -> | _ ->
prop prop
in in
if is_receiver_null then if is_receiver_null then (
(* objective-c instance method with a null receiver just return objc_null(res). *) (* objective-c instance method with a null receiver just return objc_null(res). *)
let path = Paths.Path.add_description path path_description in let path = Paths.Path.add_description path path_description in
L.d_strln L.d_strln
@ -801,7 +801,7 @@ let handle_objc_instance_method_call_or_skip pdesc tenv actual_pars path callee_
we want to add the attribute OBJC_NULL to it so that we we want to add the attribute OBJC_NULL to it so that we
can keep track of how this object became null, can keep track of how this object became null,
so that in a NPE we can separate it into a different error type *) so that in a NPE we can separate it into a different error type *)
[(add_objc_null_attribute_or_nullify_result pre, path)] [(add_objc_null_attribute_or_nullify_result pre, path)] )
else else
match force_objc_init_return_nil pdesc callee_pname tenv ret_id pre path receiver with match force_objc_init_return_nil pdesc callee_pname tenv ret_id pre path receiver with
| [] -> | [] ->

@ -419,7 +419,7 @@ let check_path_errors_in_post tenv caller_pname post post_path =
let check_attr atom = let check_attr atom =
match atom with match atom with
| Sil.Apred (Adiv0 path_pos, [e]) -> | Sil.Apred (Adiv0 path_pos, [e]) ->
if Prover.check_zero tenv e then if Prover.check_zero tenv e then (
let desc = let desc =
Errdesc.explain_divide_by_zero tenv e (State.get_node ()) (State.get_loc ()) Errdesc.explain_divide_by_zero tenv e (State.get_node ()) (State.get_loc ())
in in
@ -431,7 +431,7 @@ let check_path_errors_in_post tenv caller_pname post post_path =
in in
State.set_path new_path path_pos_opt ; State.set_path new_path path_pos_opt ;
let exn = Exceptions.Divide_by_zero (desc, __POS__) in let exn = Exceptions.Divide_by_zero (desc, __POS__) in
Reporting.log_warning_deprecated caller_pname exn Reporting.log_warning_deprecated caller_pname exn )
| _ -> | _ ->
() ()
in in
@ -964,13 +964,13 @@ let mk_actual_precondition tenv prop actual_params formal_params =
| f :: fpars', a :: apars' -> | f :: fpars', a :: apars' ->
(f, a) :: comb fpars' apars' (f, a) :: comb fpars' apars'
| [], _ -> | [], _ ->
( if apars <> [] then if apars <> [] then (
let str = let str =
"more actual pars than formal pars in fun call (" "more actual pars than formal pars in fun call ("
^ string_of_int (List.length actual_params) ^ " vs " ^ string_of_int (List.length actual_params) ^ " vs "
^ string_of_int (List.length formal_params) ^ ")" ^ string_of_int (List.length formal_params) ^ ")"
in in
L.d_warning str ; L.d_ln () ) ; L.d_warning str ; L.d_ln () ) ;
[] []
| _ :: _, [] -> | _ :: _, [] ->
raise (Exceptions.Wrong_argument_number __POS__) raise (Exceptions.Wrong_argument_number __POS__)
@ -1234,9 +1234,9 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re
let call_desc kind_opt = Localise.desc_precondition_not_met kind_opt callee_pname loc in let call_desc kind_opt = Localise.desc_precondition_not_met kind_opt callee_pname loc in
let res_with_path_idents = let res_with_path_idents =
if !Config.footprint then if !Config.footprint then
if List.is_empty valid_res_cons_pre_missing then if List.is_empty valid_res_cons_pre_missing then (
(* no valid results where actual pre and missing are consistent *) match (* no valid results where actual pre and missing are consistent *)
match deref_errors with deref_errors with
| error :: _ | error :: _
-> ( -> (
(* dereference error detected *) (* dereference error detected *)
@ -1304,7 +1304,7 @@ let exe_call_postprocess tenv ret_id trace_call callee_pname callee_attrs loc re
else call_desc None else call_desc None
in in
trace_call CR_not_met ; trace_call CR_not_met ;
raise (Exceptions.Precondition_not_met (desc, __POS__)) raise (Exceptions.Precondition_not_met (desc, __POS__)) )
else else
(* combine the valid results, and store diverging states *) (* combine the valid results, and store diverging states *)
let process_valid_res vr = let process_valid_res vr =

@ -74,8 +74,10 @@ $(b,infer) $(b,capture) $(i,[options]) $(b,--) $(b,ndk-build) $(i,...)
$(b,infer) $(b,capture) $(i,[--no-xcpretty]) $(i,[options]) $(b,--) $(b,xcodebuild) $(i,...)|} $(b,infer) $(b,capture) $(i,[--no-xcpretty]) $(i,[options]) $(b,--) $(b,xcodebuild) $(i,...)|}
~description: ~description:
[ `P [ `P
"Capture the build command or compilation database specified on the command line: infer intercepts calls to the compiler to read source files, translate them into infer's intermediate representation, and store the result of the translation in the results directory." "Capture the build command or compilation database specified on the command line: infer \
] intercepts calls to the compiler to read source files, translate them into infer's \
intermediate representation, and store the result of the translation in the results \
directory." ]
~see_also:InferCommand.([Analyze; Compile; Run]) ~see_also:InferCommand.([Analyze; Compile; Run])
@ -85,20 +87,26 @@ let compile =
~synopsis:"$(b,infer) $(b,compile) $(b,--) $(i,[compile command])" ~synopsis:"$(b,infer) $(b,compile) $(b,--) $(i,[compile command])"
~description: ~description:
[ `P [ `P
"Intercepts compilation commands similarly to $(b,infer-capture), but simply execute these compilation commands and do not perform any translation of the source files. This can be useful to configure build systems or for debugging purposes." "Intercepts compilation commands similarly to $(b,infer-capture), but simply execute \
] these compilation commands and do not perform any translation of the source files. \
This can be useful to configure build systems or for debugging purposes." ]
~examples: ~examples:
[ `P [ `P
"$(b,cmake)(1) hardcodes the absolute paths to the compiler inside the Makefiles it generates, which defeats the later capture of compilation commands by infer. Thus, to capture a CMake project, one should configure the project from within the infer build environment, for instance:" "$(b,cmake)(1) hardcodes the absolute paths to the compiler inside the Makefiles it \
generates, which defeats the later capture of compilation commands by infer. Thus, to \
capture a CMake project, one should configure the project from within the infer build \
environment, for instance:"
; `Pre {| mkdir build && cd build ; `Pre {| mkdir build && cd build
infer compile -- cmake .. infer compile -- cmake ..
infer capture -- make|} infer capture -- make|}
; `P ; `P
"The same solution can be used for projects whose \"./configure\" script hardcodes the paths to the compilers, for instance:" "The same solution can be used for projects whose \"./configure\" script hardcodes the \
paths to the compilers, for instance:"
; `Pre {| infer compile -- ./configure ; `Pre {| infer compile -- ./configure
infer capture -- make|} infer capture -- make|}
; `P ; `P
"Another solution for CMake projects is to use CMake's compilation databases, for instance:" "Another solution for CMake projects is to use CMake's compilation databases, for \
instance:"
; `Pre ; `Pre
{| mkdir build && cd build {| mkdir build && cd build
cmake -DCMAKE_EXPORT_COMPILE_COMMANDS=1 .. cmake -DCMAKE_EXPORT_COMPILE_COMMANDS=1 ..
@ -121,8 +129,8 @@ let explore =
~synopsis:{|$(b,infer) $(b,explore) $(i,[options])|} ~synopsis:{|$(b,infer) $(b,explore) $(i,[options])|}
~description: ~description:
[ `P [ `P
"Show the list of bugs on the console and explore symbolic program traces emitted by infer to explain a report. Can also generate an HTML report from a JSON report." "Show the list of bugs on the console and explore symbolic program traces emitted by \
] infer to explain a report. Can also generate an HTML report from a JSON report." ]
~see_also:InferCommand.([Report; Run]) ~see_also:InferCommand.([Report; Run])
@ -141,45 +149,64 @@ $(b,infer) $(i,[options]) $(b,--) $(b,compile command)
$(b,infer) $(i,[options])|} $(b,infer) $(i,[options])|}
~description: ~description:
[ `P [ `P
"Infer is a static analyzer. Given a collection of source files written in Java or in languages of the C family, and a command to build them, infer produces a list of potential issues." "Infer is a static analyzer. Given a collection of source files written in Java or in \
languages of the C family, and a command to build them, infer produces a list of \
potential issues."
; `P ; `P
"Infer consists of a collection of tools referenced in the $(i,SEE ALSO) section of this manual. See their respective manuals for more information." "Infer consists of a collection of tools referenced in the $(i,SEE ALSO) section of \
this manual. See their respective manuals for more information."
; `P ; `P
"When run without a subcommand, and if a compilation command is specified via the $(b,--) option or one of the $(b,--clang-compilation-database[-escaped]) options, then $(b,infer) behaves as $(b,infer-run)(1). Otherwise, $(b,infer) behaves as $(b,infer-analyze)(1)." "When run without a subcommand, and if a compilation command is specified via the \
] $(b,--) option or one of the $(b,--clang-compilation-database[-escaped]) options, then \
$(b,infer) behaves as $(b,infer-run)(1). Otherwise, $(b,infer) behaves as \
$(b,infer-analyze)(1)." ]
~options: ~options:
(`Prepend (`Prepend
[ `P "Every infer command accepts the arguments from all the other infer commands." [ `P "Every infer command accepts the arguments from all the other infer commands."
; `P ; `P
(Printf.sprintf (Printf.sprintf
"Options are read from the $(b,%s) file, then from the $(b,%s) environment variable, then from the command line. Options in $(b,%s) take precedence over options in $(b,%s), and options passed on the command line take precedence over options in $(b,%s). See the $(i,%s) and $(i,%s) sections of this manual for more information." "Options are read from the $(b,%s) file, then from the $(b,%s) environment \
inferconfig_file CLOpt.args_env_var CLOpt.args_env_var inferconfig_file variable, then from the command line. Options in $(b,%s) take precedence over \
CLOpt.args_env_var Cmdliner.Manpage.s_environment Cmdliner.Manpage.s_files) options in $(b,%s), and options passed on the command line take precedence over \
options in $(b,%s). See the $(i,%s) and $(i,%s) sections of this manual for more \
information." inferconfig_file CLOpt.args_env_var CLOpt.args_env_var
inferconfig_file CLOpt.args_env_var Cmdliner.Manpage.s_environment
Cmdliner.Manpage.s_files)
; `P ; `P
"Options can be specified inside an argument file $(i,file) by passing $(b,@)$(i,file) as argument. The format is one option per line, and enclosing single ' and double \" quotes are ignored." "Options can be specified inside an argument file $(i,file) by passing \
$(b,@)$(i,file) as argument. The format is one option per line, and enclosing single \
' and double \" quotes are ignored."
; `P ; `P
"Options without a default value (e.g., $(b,--linter)) and options with list-like values (e.g., $(b,--Xbuck)) all have a corresponding $(b,--option-reset) flag that resets their values to nothing or the empty list, respectively. For instance, $(b,--Xbuck-reset) will cancel any previous $(b,--Xbuck) option passed to infer." "Options without a default value (e.g., $(b,--linter)) and options with list-like \
values (e.g., $(b,--Xbuck)) all have a corresponding $(b,--option-reset) flag that \
resets their values to nothing or the empty list, respectively. For instance, \
$(b,--Xbuck-reset) will cancel any previous $(b,--Xbuck) option passed to infer."
; `P ; `P
"See the manuals of individual infer commands for details about their supported options. The following is a list of all the supported options (see also $(b,--help-full) for options reserved for internal use)." "See the manuals of individual infer commands for details about their supported \
]) options. The following is a list of all the supported options (see also \
$(b,--help-full) for options reserved for internal use)." ])
~environment: ~environment:
[ `P [ `P
(Printf.sprintf (Printf.sprintf
"Extra arguments may be passed to all infer commands using the $(b,%s) environment variable (see the $(i,%s) section). $(b,%s) is expected to contain a string of %c-separated options. For instance, calling `%s=--debug^--print-logs infer` is equivalent to calling `infer --debug --print-logs`." "Extra arguments may be passed to all infer commands using the $(b,%s) environment \
CLOpt.args_env_var Cmdliner.Manpage.s_options CLOpt.args_env_var CLOpt.env_var_sep variable (see the $(i,%s) section). $(b,%s) is expected to contain a string of \
CLOpt.args_env_var) %c-separated options. For instance, calling `%s=--debug^--print-logs infer` is \
equivalent to calling `infer --debug --print-logs`." CLOpt.args_env_var
Cmdliner.Manpage.s_options CLOpt.args_env_var CLOpt.env_var_sep CLOpt.args_env_var)
; `P ; `P
(Printf.sprintf "$(b,%s): Tells infer where to find the %s file. (See the %s section)" (Printf.sprintf "$(b,%s): Tells infer where to find the %s file. (See the %s section)"
inferconfig_env_var inferconfig_file Cmdliner.Manpage.s_files) inferconfig_env_var inferconfig_file Cmdliner.Manpage.s_files)
; `P ; `P
(Printf.sprintf (Printf.sprintf
"If $(b,%s) is set to \"1\", then infer commands will exit with an error code in some cases when otherwise a simple warning would be emitted on stderr, for instance if a deprecated form of an option is used." "If $(b,%s) is set to \"1\", then infer commands will exit with an error code in \
CLOpt.strict_mode_env_var) ] some cases when otherwise a simple warning would be emitted on stderr, for instance \
if a deprecated form of an option is used." CLOpt.strict_mode_env_var) ]
~files: ~files:
[ `P [ `P
(Printf.sprintf (Printf.sprintf
"$(b,%s) can be used to store infer options. Its format is that of a JSON record, where fields are infer long-form options, without their leading \"--\", and values depend on the type of the option:" "$(b,%s) can be used to store infer options. Its format is that of a JSON record, \
inferconfig_file) where fields are infer long-form options, without their leading \"--\", and values \
depend on the type of the option:" inferconfig_file)
; `Noblank ; `Noblank
; `P "- for switches options, the value is a JSON boolean (true or false, without quotes)" ; `P "- for switches options, the value is a JSON boolean (true or false, without quotes)"
; `Noblank ; `Noblank
@ -189,14 +216,14 @@ $(b,infer) $(i,[options])|}
; `Noblank ; `Noblank
; `P ; `P
(Printf.sprintf (Printf.sprintf
"- path options have string values, and are interpreted relative to the location of the %s file" "- path options have string values, and are interpreted relative to the location of \
inferconfig_file) the %s file" inferconfig_file)
; `Noblank ; `Noblank
; `P "- cumulative options are JSON arrays of the appropriate type" ; `P "- cumulative options are JSON arrays of the appropriate type"
; `P ; `P
(Printf.sprintf (Printf.sprintf
"Infer will look for an $(b,%s) file in the current directory, then its parent, etc., stopping at the first $(b,%s) file found." "Infer will look for an $(b,%s) file in the current directory, then its parent, \
inferconfig_file inferconfig_file) etc., stopping at the first $(b,%s) file found." inferconfig_file inferconfig_file)
; `P "Example:" ; `P "Example:"
; `Pre ; `Pre
{| { {| {
@ -211,10 +238,11 @@ let report =
~synopsis:"$(b,infer) $(b,report) $(i,[options]) [$(i,file.specs)...]" ~synopsis:"$(b,infer) $(b,report) $(i,[options]) [$(i,file.specs)...]"
~description: ~description:
[ `P [ `P
"Read, convert, and print .specs files in the results directory. Each spec is printed to standard output unless option -q is used." "Read, convert, and print .specs files in the results directory. Each spec is printed \
to standard output unless option -q is used."
; `P ; `P
"If no specs file are passed on the command line, process all the .specs in the results directory." "If no specs file are passed on the command line, process all the .specs in the results \
] directory." ]
~see_also:InferCommand.([ReportDiff; Run]) ~see_also:InferCommand.([ReportDiff; Run])
@ -222,10 +250,13 @@ let reportdiff =
mk_command_doc ~title:"Infer Report Difference" mk_command_doc ~title:"Infer Report Difference"
~short_description:"compute the differences between two infer reports" ~short_description:"compute the differences between two infer reports"
~synopsis: ~synopsis:
"$(b,infer) $(b,reportdiff) $(b,--report-current) $(i,file) $(b,--report-previous) $(i,file) $(i,[options])" "$(b,infer) $(b,reportdiff) $(b,--report-current) $(i,file) $(b,--report-previous) \
$(i,file) $(i,[options])"
~description: ~description:
[ `P [ `P
"Given two infer reports $(i,previous) and $(i,current), compute the following three reports and store them inside the \"differential/\" subdirectory of the results directory:" "Given two infer reports $(i,previous) and $(i,current), compute the following three \
reports and store them inside the \"differential/\" subdirectory of the results \
directory:"
; `Noblank ; `Noblank
; `P ; `P
"- $(b,introduced.json) contains the issues found in $(i,current) but not $(i,previous);" "- $(b,introduced.json) contains the issues found in $(i,current) but not $(i,previous);"
@ -233,7 +264,8 @@ let reportdiff =
; `P "- $(b,fixed.json) contains the issues found in $(i,previous) but not $(i,current);" ; `P "- $(b,fixed.json) contains the issues found in $(i,previous) but not $(i,current);"
; `Noblank ; `Noblank
; `P ; `P
"- $(b,preexisting.json) contains the issues found in both $(i,previous) and $(i,current)." "- $(b,preexisting.json) contains the issues found in both $(i,previous) and \
$(i,current)."
; `P "All three files follow the same format as normal infer reports." ] ; `P "All three files follow the same format as normal infer reports." ]
~see_also:InferCommand.([Report]) ~see_also:InferCommand.([Report])
@ -244,8 +276,8 @@ let events =
~synopsis:{|$(b,infer) $(b,events)|} ~synopsis:{|$(b,infer) $(b,events)|}
~description: ~description:
[ `P [ `P
"Emit to stdout one JSON object per line, each describing a logged event happened during the execution of Infer" "Emit to stdout one JSON object per line, each describing a logged event happened \
] during the execution of Infer" ]
~see_also:InferCommand.([Report; Run]) ~see_also:InferCommand.([Report; Run])
@ -257,7 +289,8 @@ let run =
$(b,infer) $(i,[options]) $(b,--) $(i,compile command)|} $(b,infer) $(i,[options]) $(b,--) $(i,compile command)|}
~description: ~description:
[ `P [ `P
"Calling \"$(b,infer) $(b,run) $(i,[options])\" is equivalent to performing the following sequence of commands:" "Calling \"$(b,infer) $(b,run) $(i,[options])\" is equivalent to performing the \
following sequence of commands:"
; `Pre {|$(b,infer) $(b,capture) $(i,[options]) ; `Pre {|$(b,infer) $(b,capture) $(i,[options])
$(b,infer) $(b,analyze) $(i,[options])|} ] $(b,infer) $(b,analyze) $(i,[options])|} ]
~see_also:InferCommand.([Analyze; Capture; Report]) ~see_also:InferCommand.([Analyze; Capture; Report])

@ -477,7 +477,7 @@ let mk_string_list ?(default= []) ?(f= fun s -> s) ?(deprecated= []) ~long ?shor
let normalize_path_in_args_being_parsed ?(f= Fn.id) ~is_anon_arg str = let normalize_path_in_args_being_parsed ?(f= Fn.id) ~is_anon_arg str =
if Filename.is_relative str then if Filename.is_relative str then (
(* Replace relative paths with absolute ones on the fly in the args being parsed. This assumes (* Replace relative paths with absolute ones on the fly in the args being parsed. This assumes
that [!arg_being_parsed] points at either [str] (if [is_anon_arg]) or at the option name that [!arg_being_parsed] points at either [str] (if [is_anon_arg]) or at the option name
position in [!args_to_parse], as is the case e.g. when calling position in [!args_to_parse], as is the case e.g. when calling
@ -485,7 +485,7 @@ let normalize_path_in_args_being_parsed ?(f= Fn.id) ~is_anon_arg str =
let root = Unix.getcwd () in let root = Unix.getcwd () in
let abs_path = Utils.filename_to_absolute ~root str in let abs_path = Utils.filename_to_absolute ~root str in
!args_to_parse.((!arg_being_parsed + if is_anon_arg then 0 else 1)) <- f abs_path ; !args_to_parse.((!arg_being_parsed + if is_anon_arg then 0 else 1)) <- f abs_path ;
abs_path abs_path )
else str else str
@ -922,7 +922,7 @@ let parse ?config_file ~usage action initial_command =
in in
let to_export = let to_export =
let argv_to_export = decode_env_to_argv !args_to_export in let argv_to_export = decode_env_to_argv !args_to_export in
if argv_to_export <> [] then if argv_to_export <> [] then (
(* We have to be careful not to add too much data to the environment because the size of the (* We have to be careful not to add too much data to the environment because the size of the
environment contributes to the length of the command to be run. If the environment + CLI is environment contributes to the length of the command to be run. If the environment + CLI is
too big, running any command will fail with a cryptic "exit code 127" error. Use an argfile too big, running any command will fail with a cryptic "exit code 127" error. Use an argfile
@ -930,7 +930,7 @@ let parse ?config_file ~usage action initial_command =
let file = Filename.temp_file "args_" "" in let file = Filename.temp_file "args_" "" in
Out_channel.with_file file ~f:(fun oc -> Out_channel.output_lines oc argv_to_export) ; Out_channel.with_file file ~f:(fun oc -> Out_channel.output_lines oc argv_to_export) ;
if not !keep_args_file then Utils.unlink_file_on_exit file ; if not !keep_args_file then Utils.unlink_file_on_exit file ;
"@" ^ file "@" ^ file )
else "" else ""
in in
Unix.putenv ~key:args_env_var ~data:to_export ; Unix.putenv ~key:args_env_var ~data:to_export ;

@ -614,12 +614,12 @@ and ( analysis_blacklist_files_containing_options
( mk_filtering_options ~suffix:"blacklist-files-containing" ( mk_filtering_options ~suffix:"blacklist-files-containing"
~deprecated_suffix:["blacklist_files_containing"] ~deprecated_suffix:["blacklist_files_containing"]
~help: ~help:
"blacklist files containing the specified string for the given analyzer (see $(b,--analyzer) for valid values)" "blacklist files containing the specified string for the given analyzer (see \
~meta:"string" $(b,--analyzer) for valid values)" ~meta:"string"
, mk_filtering_options ~suffix:"blacklist-path-regex" ~deprecated_suffix:["blacklist"] , mk_filtering_options ~suffix:"blacklist-path-regex" ~deprecated_suffix:["blacklist"]
~help: ~help:
"blacklist the analysis of files whose relative path matches the specified OCaml-style regex (to whitelist: $(b,--<analyzer>-whitelist-path-regex))" "blacklist the analysis of files whose relative path matches the specified OCaml-style \
~meta:"path_regex" regex (to whitelist: $(b,--<analyzer>-whitelist-path-regex))" ~meta:"path_regex"
, mk_filtering_options ~suffix:"whitelist-path-regex" ~deprecated_suffix:["whitelist"] ~help:"" , mk_filtering_options ~suffix:"whitelist-path-regex" ~deprecated_suffix:["whitelist"] ~help:""
~meta:"path_regex" ~meta:"path_regex"
, mk_filtering_options ~suffix:"suppress-errors" ~deprecated_suffix:["suppress_errors"] , mk_filtering_options ~suffix:"suppress-errors" ~deprecated_suffix:["suppress_errors"]
@ -660,8 +660,9 @@ and analyzer =
if equal_analyzer x y then Some s else None ) if equal_analyzer x y then Some s else None )
in in
CLOpt.warnf CLOpt.warnf
"WARNING: The analyzer '%s' is deprecated, use the '%s' subcommand instead:@\n@\n infer %s ..." "WARNING: The analyzer '%s' is deprecated, use the '%s' subcommand instead:@\n\
analyzer_str analyzer_str analyzer_str ; @\n \
infer %s ..." analyzer_str analyzer_str analyzer_str ;
x x
| _ as x -> | _ as x ->
x) x)
@ -698,7 +699,10 @@ and ( annotation_reachability
in in
let annotation_reachability = let annotation_reachability =
mk_checker ~default:true ~long:"annotation-reachability" mk_checker ~default:true ~long:"annotation-reachability"
"the annotation reachability checker. Given a pair of source and sink annotation, e.g. @PerformanceCritical and @Expensive, this checker will warn whenever some method annotated with @PerformanceCritical calls, directly or indirectly, another method annotated with @Expensive" "the annotation reachability checker. Given a pair of source and sink annotation, e.g. \
@PerformanceCritical and @Expensive, this checker will warn whenever some method annotated \
with @PerformanceCritical calls, directly or indirectly, another method annotated with \
@Expensive"
and biabduction = and biabduction =
mk_checker ~long:"biabduction" ~default:true mk_checker ~long:"biabduction" ~default:true
"the separation logic based bi-abduction analysis using the checkers framework" "the separation logic based bi-abduction analysis using the checkers framework"
@ -716,7 +720,8 @@ and ( annotation_reachability
"detects when Android fragments are not explicitly nullified before becoming unreabable" "detects when Android fragments are not explicitly nullified before becoming unreabable"
and immutable_cast = and immutable_cast =
mk_checker ~long:"immutable-cast" ~default:true mk_checker ~long:"immutable-cast" ~default:true
"the detection of object cast from immutable type to mutable type. For instance, it will detect cast from ImmutableList to List, ImmutableMap to Map, and ImmutableSet to Set." "the detection of object cast from immutable type to mutable type. For instance, it will \
detect cast from ImmutableList to List, ImmutableMap to Map, and ImmutableSet to Set."
and linters = mk_checker ~long:"linters" ~default:true "syntactic linters" and linters = mk_checker ~long:"linters" ~default:true "syntactic linters"
and litho = mk_checker ~long:"litho" "Experimental checkers supporting the Litho framework" and litho = mk_checker ~long:"litho" "Experimental checkers supporting the Litho framework"
and liveness = and liveness =
@ -724,7 +729,9 @@ and ( annotation_reachability
and ownership = mk_checker ~long:"ownership" ~default:false "the detection of C++ lifetime bugs" and ownership = mk_checker ~long:"ownership" ~default:false "the detection of C++ lifetime bugs"
and printf_args = and printf_args =
mk_checker ~long:"printf-args" ~default:true mk_checker ~long:"printf-args" ~default:true
"the detection of mismatch between the Java printf format strings and the argument types For, example, this checker will warn about the type error in `printf(\"Hello %d\", \"world\")`" "the detection of mismatch between the Java printf format strings and the argument types \
For, example, this checker will warn about the type error in `printf(\"Hello %d\", \
\"world\")`"
and quandary = mk_checker ~long:"quandary" ~default:true "the quandary taint analysis" and quandary = mk_checker ~long:"quandary" ~default:true "the quandary taint analysis"
and racerd = and racerd =
mk_checker ~long:"racerd" ~deprecated:["-threadsafety"] ~default:true mk_checker ~long:"racerd" ~deprecated:["-threadsafety"] ~default:true
@ -804,7 +811,8 @@ Example format: for custom annotations com.my.annotation.{Source1,Source2,Sink1}
and append_buck_flavors = and append_buck_flavors =
CLOpt.mk_string_list ~long:"append-buck-flavors" CLOpt.mk_string_list ~long:"append-buck-flavors"
~in_help:InferCommand.([(Capture, manual_buck_flavors)]) ~in_help:InferCommand.([(Capture, manual_buck_flavors)])
"Additional Buck flavors to append to targets discovered by the $(b,--buck-compilation-database) option." "Additional Buck flavors to append to targets discovered by the \
$(b,--buck-compilation-database) option."
and array_level = and array_level =
@ -840,8 +848,8 @@ and buck_build_args =
and buck_compilation_database_depth = and buck_compilation_database_depth =
CLOpt.mk_int_opt ~long:"buck-compilation-database-depth" CLOpt.mk_int_opt ~long:"buck-compilation-database-depth"
~in_help:InferCommand.([(Capture, manual_buck_compilation_db)]) ~in_help:InferCommand.([(Capture, manual_buck_compilation_db)])
"Depth of dependencies used by the $(b,--buck-compilation-database deps) option. By default, all recursive dependencies are captured." "Depth of dependencies used by the $(b,--buck-compilation-database deps) option. By default, \
~meta:"int" all recursive dependencies are captured." ~meta:"int"
and buck_compilation_database = and buck_compilation_database =
@ -866,7 +874,8 @@ and changed_files_index =
CLOpt.mk_path_opt ~long:"changed-files-index" CLOpt.mk_path_opt ~long:"changed-files-index"
~in_help:InferCommand.([(Analyze, manual_generic); (Diff, manual_generic)]) ~in_help:InferCommand.([(Analyze, manual_generic); (Diff, manual_generic)])
~meta:"file" ~meta:"file"
"Specify the file containing the list of source files from which reactive analysis should start. Source files should be specified relative to project root or be absolute" "Specify the file containing the list of source files from which reactive analysis should \
start. Source files should be specified relative to project root or be absolute"
and check_version = and check_version =
@ -892,12 +901,16 @@ and clang_frontend_action =
and clang_include_to_override_regex = and clang_include_to_override_regex =
CLOpt.mk_string_opt ~long:"clang-include-to-override-regex" CLOpt.mk_string_opt ~long:"clang-include-to-override-regex"
~deprecated:["-clang-include-to-override"] ~meta:"dir_OCaml_regex" ~deprecated:["-clang-include-to-override"] ~meta:"dir_OCaml_regex"
"Use this option in the uncommon case where the normal compilation process overrides the location of internal compiler headers. This option should specify regular expression with the path to those headers so that infer can use its own clang internal headers instead." "Use this option in the uncommon case where the normal compilation process overrides the \
location of internal compiler headers. This option should specify regular expression with \
the path to those headers so that infer can use its own clang internal headers instead."
and clang_ignore_regex = and clang_ignore_regex =
CLOpt.mk_string_opt ~long:"clang-ignore-regex" ~meta:"dir_OCaml_regex" CLOpt.mk_string_opt ~long:"clang-ignore-regex" ~meta:"dir_OCaml_regex"
"The files in this regex will be ignored in the compilation process and an empty file will be passed to clang instead. This is to be used with the buck flavour infer-capture-all to work around missing generated files." "The files in this regex will be ignored in the compilation process and an empty file will be \
passed to clang instead. This is to be used with the buck flavour infer-capture-all to work \
around missing generated files."
and classpath = CLOpt.mk_string_opt ~long:"classpath" "Specify the Java classpath" and classpath = CLOpt.mk_string_opt ~long:"classpath" "Specify the Java classpath"
@ -917,13 +930,15 @@ and compilation_database_escaped =
CLOpt.mk_path_list ~long:"compilation-database-escaped" CLOpt.mk_path_list ~long:"compilation-database-escaped"
~deprecated:["-clang-compilation-db-files-escaped"] ~deprecated:["-clang-compilation-db-files-escaped"]
~in_help:InferCommand.([(Capture, manual_clang)]) ~in_help:InferCommand.([(Capture, manual_clang)])
"File that contain compilation commands where all entries are escaped for the shell, eg coming from Xcode (can be specified multiple times)" "File that contain compilation commands where all entries are escaped for the shell, eg \
coming from Xcode (can be specified multiple times)"
and compute_analytics = and compute_analytics =
CLOpt.mk_bool ~long:"compute-analytics" ~default:false CLOpt.mk_bool ~long:"compute-analytics" ~default:false
~in_help:InferCommand.([(Capture, manual_clang); (Run, manual_clang)]) ~in_help:InferCommand.([(Capture, manual_clang); (Run, manual_clang)])
"Emit analytics as info-level issues, like component kit line count and component kit file cyclomatic complexity" "Emit analytics as info-level issues, like component kit line count and component kit file \
cyclomatic complexity"
(** Continue the capture for reactive mode: (** Continue the capture for reactive mode:
@ -931,26 +946,31 @@ and compute_analytics =
and continue = and continue =
CLOpt.mk_bool ~deprecated:["continue"] ~long:"continue" CLOpt.mk_bool ~deprecated:["continue"] ~long:"continue"
~in_help:InferCommand.([(Analyze, manual_generic)]) ~in_help:InferCommand.([(Analyze, manual_generic)])
"Continue the capture for the reactive analysis, increasing the changed files/procedures. (If a procedure was changed beforehand, keep the changed marking.)" "Continue the capture for the reactive analysis, increasing the changed files/procedures. (If \
a procedure was changed beforehand, keep the changed marking.)"
and current_to_previous_script = and current_to_previous_script =
CLOpt.mk_string_opt ~long:"current-to-previous-script" CLOpt.mk_string_opt ~long:"current-to-previous-script"
~in_help:InferCommand.([(Diff, manual_generic)]) ~in_help:InferCommand.([(Diff, manual_generic)])
~meta:"shell" ~meta:"shell"
"Specify a script to checkout a previous version of the project to compare against, assuming we are on the current version already." "Specify a script to checkout a previous version of the project to compare against, assuming \
we are on the current version already."
and cxx_infer_headers = and cxx_infer_headers =
CLOpt.mk_bool ~long:"cxx-infer-headers" ~default:true CLOpt.mk_bool ~long:"cxx-infer-headers" ~default:true
~in_help:InferCommand.([(Capture, manual_clang)]) ~in_help:InferCommand.([(Capture, manual_clang)])
"Include C++ header models during compilation. Infer swaps some C++ headers for its own in order to get a better model of, eg, the standard library. This can sometimes cause compilation failures." "Include C++ header models during compilation. Infer swaps some C++ headers for its own in \
order to get a better model of, eg, the standard library. This can sometimes cause \
compilation failures."
and cxx_scope_guards = and cxx_scope_guards =
CLOpt.mk_json ~long:"cxx-scope-guards" CLOpt.mk_json ~long:"cxx-scope-guards"
~in_help:InferCommand.([(Analyze, manual_clang)]) ~in_help:InferCommand.([(Analyze, manual_clang)])
"Specify scope guard classes that can be read only by destructors without being reported as dead stores." "Specify scope guard classes that can be read only by destructors without being reported as \
dead stores."
and cxx = and cxx =
@ -1040,7 +1060,9 @@ and ( bo_debug
let debug = let debug =
CLOpt.mk_bool_group ~deprecated:["debug"; "-stats"] ~long:"debug" ~short:'g' CLOpt.mk_bool_group ~deprecated:["debug"; "-stats"] ~long:"debug" ~short:'g'
~in_help:all_generic_manuals ~in_help:all_generic_manuals
"Debug mode (also sets $(b,--debug-level 2), $(b,--developer-mode), $(b,--no-filtering), $(b,--print-buckets), $(b,--print-types), $(b,--reports-include-ml-loc), $(b,--no-only-cheap-debug), $(b,--trace-error), $(b,--write-dotty), $(b,--write-html))" "Debug mode (also sets $(b,--debug-level 2), $(b,--developer-mode), $(b,--no-filtering), \
$(b,--print-buckets), $(b,--print-types), $(b,--reports-include-ml-loc), \
$(b,--no-only-cheap-debug), $(b,--trace-error), $(b,--write-dotty), $(b,--write-html))"
~f:(fun debug -> ~f:(fun debug ->
if debug then set_debug_level 2 else set_debug_level 0 ; if debug then set_debug_level 2 else set_debug_level 0 ;
CommandLineOption.keep_args_file := debug ; CommandLineOption.keep_args_file := debug ;
@ -1061,8 +1083,10 @@ and ( bo_debug
- 2: very verbose debugging enabled|} - 2: very verbose debugging enabled|}
and debug_exceptions = and debug_exceptions =
CLOpt.mk_bool_group ~long:"debug-exceptions" CLOpt.mk_bool_group ~long:"debug-exceptions"
"Generate lightweight debugging information: just print the internal exceptions during analysis (also sets $(b,--developer-mode), $(b,--no-filtering), $(b,--print-buckets), $(b,--reports-include-ml-loc))" "Generate lightweight debugging information: just print the internal exceptions during \
[developer_mode; print_buckets; reports_include_ml_loc] [filtering; keep_going] analysis (also sets $(b,--developer-mode), $(b,--no-filtering), $(b,--print-buckets), \
$(b,--reports-include-ml-loc))" [developer_mode; print_buckets; reports_include_ml_loc]
[filtering; keep_going]
and default_linters = and default_linters =
CLOpt.mk_bool ~long:"default-linters" CLOpt.mk_bool ~long:"default-linters"
~in_help:InferCommand.([(Capture, manual_clang_linters)]) ~in_help:InferCommand.([(Capture, manual_clang_linters)])
@ -1070,8 +1094,8 @@ and ( bo_debug
and frontend_tests = and frontend_tests =
CLOpt.mk_bool_group ~long:"frontend-tests" CLOpt.mk_bool_group ~long:"frontend-tests"
~in_help:InferCommand.([(Capture, manual_clang)]) ~in_help:InferCommand.([(Capture, manual_clang)])
"Save filename.ext.test.dot with the cfg in dotty format for frontend tests (also sets $(b,--print-types))" "Save filename.ext.test.dot with the cfg in dotty format for frontend tests (also sets \
[print_types] [] $(b,--print-types))" [print_types] []
and models_mode = and models_mode =
CLOpt.mk_bool_group ~long:"models-mode" "Mode for analyzing the models" [] [keep_going] CLOpt.mk_bool_group ~long:"models-mode" "Mode for analyzing the models" [] [keep_going]
and print_logs = and print_logs =
@ -1087,7 +1111,9 @@ and ( bo_debug
let linters_developer_mode = let linters_developer_mode =
CLOpt.mk_bool_group ~long:"linters-developer-mode" CLOpt.mk_bool_group ~long:"linters-developer-mode"
~in_help:InferCommand.([(Capture, manual_clang_linters)]) ~in_help:InferCommand.([(Capture, manual_clang_linters)])
"Debug mode for developing new linters. (Sets the analyzer to $(b,linters); also sets $(b,--debug), $(b,--debug-level-linters 2), $(b,--developer-mode), and unsets $(b,--allowed-failures) and $(b,--default-linters)." "Debug mode for developing new linters. (Sets the analyzer to $(b,linters); also sets \
$(b,--debug), $(b,--debug-level-linters 2), $(b,--developer-mode), and unsets \
$(b,--allowed-failures) and $(b,--default-linters)."
~f:(fun debug -> ~f:(fun debug ->
debug_level_linters := if debug then 2 else 0 ; debug_level_linters := if debug then 2 else 0 ;
debug ) debug )
@ -1120,18 +1146,22 @@ and ( bo_debug
and dependencies = and dependencies =
CLOpt.mk_bool ~deprecated:["dependencies"] ~long:"dependencies" CLOpt.mk_bool ~deprecated:["dependencies"] ~long:"dependencies"
~in_help:InferCommand.([(Capture, manual_java)]) ~in_help:InferCommand.([(Capture, manual_java)])
"Translate all the dependencies during the capture. The classes in the given jar file will be translated. No sources needed." "Translate all the dependencies during the capture. The classes in the given jar file will be \
translated. No sources needed."
and differential_filter_files = and differential_filter_files =
CLOpt.mk_string_opt ~long:"differential-filter-files" CLOpt.mk_string_opt ~long:"differential-filter-files"
~in_help:InferCommand.([(Report, manual_generic)]) ~in_help:InferCommand.([(Report, manual_generic)])
"Specify the file containing the list of source files for which a differential report is desired. Source files should be specified relative to project root or be absolute" "Specify the file containing the list of source files for which a differential report is \
desired. Source files should be specified relative to project root or be absolute"
and differential_filter_set = and differential_filter_set =
CLOpt.mk_symbol_seq ~long:"differential-filter-set" ~eq:PVariant.( = ) CLOpt.mk_symbol_seq ~long:"differential-filter-set" ~eq:PVariant.( = )
"Specify which set of the differential results is filtered with the modified files provided through the $(b,--differential-modified-files) argument. By default it is applied to all sets ($(b,introduced), $(b,fixed), and $(b,preexisting))" "Specify which set of the differential results is filtered with the modified files provided \
through the $(b,--differential-modified-files) argument. By default it is applied to all \
sets ($(b,introduced), $(b,fixed), and $(b,preexisting))"
~symbols:[("introduced", `Introduced); ("fixed", `Fixed); ("preexisting", `Preexisting)] ~symbols:[("introduced", `Introduced); ("fixed", `Fixed); ("preexisting", `Preexisting)]
~default:[`Introduced; `Fixed; `Preexisting] ~default:[`Introduced; `Fixed; `Preexisting]
@ -1157,10 +1187,19 @@ and () =
mk false ~default:disabled_issues_ids ~long:"disable-issue-type" mk false ~default:disabled_issues_ids ~long:"disable-issue-type"
~deprecated:["disable_checks"; "-disable-checks"] ~deprecated:["disable_checks"; "-disable-checks"]
(Printf.sprintf (Printf.sprintf
"Do not show reports coming from this type of issue. Each checker can report a range of issue types. This option provides fine-grained filtering over which types of issue should be reported once the checkers have run. In particular, note that disabling issue types does not make the corresponding checker not run.\n By default, the following issue types are disabled: %s.\n\n See also $(b,--report-issue-type).\n" "Do not show reports coming from this type of issue. Each checker can report a range of \
issue types. This option provides fine-grained filtering over which types of issue should \
be reported once the checkers have run. In particular, note that disabling issue types \
does not make the corresponding checker not run.\n \
By default, the following issue types are disabled: %s.\n\
\n \
See also $(b,--report-issue-type).\n\
"
(String.concat ~sep:", " disabled_issues_ids)) ; (String.concat ~sep:", " disabled_issues_ids)) ;
mk true ~long:"enable-issue-type" ~deprecated:["enable_checks"; "-enable-checks"] mk true ~long:"enable-issue-type" ~deprecated:["enable_checks"; "-enable-checks"]
"Show reports coming from this type of issue. By default, all issue types are enabled except the ones listed in $(b,--disable-issue-type). Note that enabling issue types does not make the corresponding checker run; see individual checker options to turn them on or off." "Show reports coming from this type of issue. By default, all issue types are enabled except \
the ones listed in $(b,--disable-issue-type). Note that enabling issue types does not make \
the corresponding checker run; see individual checker options to turn them on or off."
and dotty_cfg_libs = and dotty_cfg_libs =
@ -1228,13 +1267,23 @@ and filter_paths =
and filter_report = and filter_report =
CLOpt.mk_string_list ~long:"filter-report" CLOpt.mk_string_list ~long:"filter-report"
~in_help:InferCommand.([(Report, manual_generic); (Run, manual_generic)]) ~in_help:InferCommand.([(Report, manual_generic); (Run, manual_generic)])
"Specify a filter for issues to report. If multiple filters are specified, they are applied in the order in which they are specified. Each filter is applied to each issue detected, and only issues which are accepted by all filters are reported. Each filter is of the form: `<issue_type_regex>:<filename_regex>:<reason_string>`. The first two components are OCaml Str regular expressions, with an optional `!` character prefix. If a regex has a `!` prefix, the polarity is inverted, and the filter becomes a \"blacklist\" instead of a \"whitelist\". Each filter is interpreted as an implication: an issue matches if it does not match the `issue_type_regex` or if it does match the `filename_regex`. The filenames that are tested by the regex are relative to the `--project-root` directory. The `<reason_string>` is a non-empty string used to explain why the issue was filtered." "Specify a filter for issues to report. If multiple filters are specified, they are applied \
in the order in which they are specified. Each filter is applied to each issue detected, and \
only issues which are accepted by all filters are reported. Each filter is of the form: \
`<issue_type_regex>:<filename_regex>:<reason_string>`. The first two components are OCaml \
Str regular expressions, with an optional `!` character prefix. If a regex has a `!` prefix, \
the polarity is inverted, and the filter becomes a \"blacklist\" instead of a \"whitelist\". \
Each filter is interpreted as an implication: an issue matches if it does not match the \
`issue_type_regex` or if it does match the `filename_regex`. The filenames that are tested \
by the regex are relative to the `--project-root` directory. The `<reason_string>` is a \
non-empty string used to explain why the issue was filtered."
and flavors = and flavors =
CLOpt.mk_bool ~deprecated:["-use-flavors"] ~long:"flavors" CLOpt.mk_bool ~deprecated:["-use-flavors"] ~long:"flavors"
~in_help:InferCommand.([(Capture, manual_buck_flavors)]) ~in_help:InferCommand.([(Capture, manual_buck_flavors)])
"Buck integration using Buck flavors (clang only), eg $(i,`infer --flavors -- buck build //foo:bar#infer`)" "Buck integration using Buck flavors (clang only), eg $(i,`infer --flavors -- buck build \
//foo:bar#infer`)"
and force_delete_results_dir = and force_delete_results_dir =
@ -1245,7 +1294,8 @@ and force_delete_results_dir =
; (Compile, manual_generic) ; (Compile, manual_generic)
; (Diff, manual_generic) ; (Diff, manual_generic)
; (Run, manual_generic) ]) ; (Run, manual_generic) ])
"Do not refuse to delete the results directory if it doesn't look like an infer results directory." "Do not refuse to delete the results directory if it doesn't look like an infer results \
directory."
and force_integration = and force_integration =
@ -1262,7 +1312,8 @@ and from_json_report =
CLOpt.mk_path_opt ~long:"from-json-report" CLOpt.mk_path_opt ~long:"from-json-report"
~in_help:InferCommand.([(Report, manual_generic)]) ~in_help:InferCommand.([(Report, manual_generic)])
~meta:"report.json" ~meta:"report.json"
"Load analysis results from a report file (default is to load the results from the specs files generated by the analysis)." "Load analysis results from a report file (default is to load the results from the specs \
files generated by the analysis)."
and frontend_stats = and frontend_stats =
@ -1274,7 +1325,8 @@ and gen_previous_build_command_script =
CLOpt.mk_string_opt ~long:"gen-previous-build-command-script" CLOpt.mk_string_opt ~long:"gen-previous-build-command-script"
~in_help:InferCommand.([(Diff, manual_generic)]) ~in_help:InferCommand.([(Diff, manual_generic)])
~meta:"shell" ~meta:"shell"
"Specify a script that outputs the build command to capture in the previous version of the project. The script should output the command on stdout. For example \"echo make\"." "Specify a script that outputs the build command to capture in the previous version of the \
project. The script should output the command on stdout. For example \"echo make\"."
and generated_classes = and generated_classes =
@ -1305,7 +1357,8 @@ and help_format =
~symbols:[("auto", `Auto); ("groff", `Groff); ("pager", `Pager); ("plain", `Plain)] ~symbols:[("auto", `Auto); ("groff", `Groff); ("pager", `Pager); ("plain", `Plain)]
~eq:PVariant.( = ) ~default:`Auto ~eq:PVariant.( = ) ~default:`Auto
~in_help:(List.map InferCommand.all_commands ~f:(fun command -> (command, manual_generic))) ~in_help:(List.map InferCommand.all_commands ~f:(fun command -> (command, manual_generic)))
"Show this help in the specified format. $(b,auto) sets the format to $(b,plain) if the environment variable $(b,TERM) is \"dumb\" or undefined, and to $(b,pager) otherwise." "Show this help in the specified format. $(b,auto) sets the format to $(b,plain) if the \
environment variable $(b,TERM) is \"dumb\" or undefined, and to $(b,pager) otherwise."
and html = and html =
@ -1316,7 +1369,8 @@ and html =
and icfg_dotty_outfile = and icfg_dotty_outfile =
CLOpt.mk_path_opt ~long:"icfg-dotty-outfile" ~meta:"path" CLOpt.mk_path_opt ~long:"icfg-dotty-outfile" ~meta:"path"
"If set, specifies path where .dot file should be written, it overrides the path for all other options that would generate icfg file otherwise" "If set, specifies path where .dot file should be written, it overrides the path for all \
other options that would generate icfg file otherwise"
and ignore_trivial_traces = and ignore_trivial_traces =
@ -1338,7 +1392,8 @@ and iphoneos_target_sdk_version =
and iphoneos_target_sdk_version_path_regex = and iphoneos_target_sdk_version_path_regex =
CLOpt.mk_string_list ~long:"iphoneos-target-sdk-version-path-regex" CLOpt.mk_string_list ~long:"iphoneos-target-sdk-version-path-regex"
~in_help:InferCommand.([(Capture, manual_clang_linters)]) ~in_help:InferCommand.([(Capture, manual_clang_linters)])
"To pass a specific target SDK version to use for iphoneos in a particular path, with the format path:version (can be specified multiple times)" "To pass a specific target SDK version to use for iphoneos in a particular path, with the \
format path:version (can be specified multiple times)"
and issues_fields = and issues_fields =
@ -1367,7 +1422,8 @@ and issues_txt =
and iterations = and iterations =
CLOpt.mk_int ~deprecated:["iterations"] ~long:"iterations" ~default:1 ~meta:"int" CLOpt.mk_int ~deprecated:["iterations"] ~long:"iterations" ~default:1 ~meta:"int"
"Specify the maximum number of operations for each function, expressed as a multiple of symbolic operations and a multiple of seconds of elapsed time" "Specify the maximum number of operations for each function, expressed as a multiple of \
symbolic operations and a multiple of seconds of elapsed time"
and java_jar_compiler = and java_jar_compiler =
@ -1404,7 +1460,8 @@ and log_file =
and linter = and linter =
CLOpt.mk_string_opt ~long:"linter" CLOpt.mk_string_opt ~long:"linter"
~in_help:InferCommand.([(Capture, manual_clang_linters)]) ~in_help:InferCommand.([(Capture, manual_clang_linters)])
"From the linters available, only run this one linter. (Useful together with $(b,--linters-developer-mode))" "From the linters available, only run this one linter. (Useful together with \
$(b,--linters-developer-mode))"
and linters_def_file = and linters_def_file =
@ -1421,7 +1478,8 @@ and linters_def_folder =
in in
let () = let () =
CLOpt.mk_set linters_def_folder [] ~long:"reset-linters-def-folder" CLOpt.mk_set linters_def_folder [] ~long:"reset-linters-def-folder"
"Reset the list of folders containing linters definitions to be empty (see $(b,linters-def-folder))." "Reset the list of folders containing linters definitions to be empty (see \
$(b,linters-def-folder))."
in in
linters_def_folder linters_def_folder
@ -1429,7 +1487,9 @@ and linters_def_folder =
and linters_doc_url = and linters_doc_url =
CLOpt.mk_string_list ~long:"linters-doc-url" CLOpt.mk_string_list ~long:"linters-doc-url"
~in_help:InferCommand.([(Capture, manual_clang_linters)]) ~in_help:InferCommand.([(Capture, manual_clang_linters)])
"Specify custom documentation URL for some linter that overrides the default one. Useful if your project has specific ways of fixing a lint error that is not true in general or public info. Format: linter_name:doc_url." "Specify custom documentation URL for some linter that overrides the default one. Useful if \
your project has specific ways of fixing a lint error that is not true in general or public \
info. Format: linter_name:doc_url."
and linters_ignore_clang_failures = and linters_ignore_clang_failures =
@ -1449,7 +1509,8 @@ and load_average =
CLOpt.mk_float_opt ~long:"load-average" ~short:'l' CLOpt.mk_float_opt ~long:"load-average" ~short:'l'
~in_help:InferCommand.([(Capture, manual_generic)]) ~in_help:InferCommand.([(Capture, manual_generic)])
~meta:"float" ~meta:"float"
"Do not start new parallel jobs if the load average is greater than that specified (Buck and make only)" "Do not start new parallel jobs if the load average is greater than that specified (Buck and \
make only)"
and margin = and margin =
@ -1460,7 +1521,8 @@ and margin =
and max_nesting = and max_nesting =
CLOpt.mk_int_opt ~long:"max-nesting" CLOpt.mk_int_opt ~long:"max-nesting"
~in_help:InferCommand.([(Explore, manual_generic)]) ~in_help:InferCommand.([(Explore, manual_generic)])
"Level of nested procedure calls to show. Trace elements beyond the maximum nesting level are skipped. If omitted, all levels are shown." "Level of nested procedure calls to show. Trace elements beyond the maximum nesting level are \
skipped. If omitted, all levels are shown."
and merge = and merge =
@ -1507,15 +1569,16 @@ and only_show =
and passthroughs = and passthroughs =
CLOpt.mk_bool ~long:"passthroughs" ~default:false CLOpt.mk_bool ~long:"passthroughs" ~default:false
"In error traces, show intermediate steps that propagate data. When false, error traces are shorter and show only direct flow via souces/sinks" "In error traces, show intermediate steps that propagate data. When false, error traces are \
shorter and show only direct flow via souces/sinks"
and patterns_modeled_expensive = and patterns_modeled_expensive =
let long = "modeled-expensive" in let long = "modeled-expensive" in
( long ( long
, CLOpt.mk_json ~deprecated:["modeled_expensive"] ~long , CLOpt.mk_json ~deprecated:["modeled_expensive"] ~long
"Matcher or list of matchers for methods that should be considered expensive by the performance critical checker." "Matcher or list of matchers for methods that should be considered expensive by the \
) performance critical checker." )
and patterns_never_returning_null = and patterns_never_returning_null =
@ -1529,8 +1592,8 @@ and patterns_skip_implementation =
let long = "skip-implementation" in let long = "skip-implementation" in
( long ( long
, CLOpt.mk_json ~long , CLOpt.mk_json ~long
"Matcher or list of matchers for names of files where we only want to translate the method declaration, skipping the body of the methods (Java only)." "Matcher or list of matchers for names of files where we only want to translate the method \
) declaration, skipping the body of the methods (Java only)." )
and patterns_skip_translation = and patterns_skip_translation =
@ -1560,7 +1623,10 @@ and previous_to_current_script =
CLOpt.mk_string_opt ~long:"previous-to-current-script" CLOpt.mk_string_opt ~long:"previous-to-current-script"
~in_help:InferCommand.([(Diff, manual_generic)]) ~in_help:InferCommand.([(Diff, manual_generic)])
~meta:"shell" ~meta:"shell"
"Specify a script to checkout the current version of the project. The project is supposed to already be at that current version when running $(b,infer diff); the script is used after having analyzed the current and previous versions of the project, to restore the project to the current version." "Specify a script to checkout the current version of the project. The project is supposed to \
already be at that current version when running $(b,infer diff); the script is used after \
having analyzed the current and previous versions of the project, to restore the project to \
the current version."
and print_active_checkers = and print_active_checkers =
@ -1587,7 +1653,9 @@ and print_using_diff =
and procedures_per_process = and procedures_per_process =
CLOpt.mk_int ~long:"procedures-per-process" ~default:1000 ~meta:"int" CLOpt.mk_int ~long:"procedures-per-process" ~default:1000 ~meta:"int"
"Specify the number of procedures to analyze per process when using $(b,--per-procedure-parallelism). If 0 is specified, each file is divided into $(b,--jobs) groups of procedures." "Specify the number of procedures to analyze per process when using \
$(b,--per-procedure-parallelism). If 0 is specified, each file is divided into $(b,--jobs) \
groups of procedures."
and procs_csv = and procs_csv =
@ -1652,7 +1720,8 @@ and racerd_use_path_stability =
and reactive = and reactive =
CLOpt.mk_bool ~deprecated:["reactive"] ~long:"reactive" ~short:'r' CLOpt.mk_bool ~deprecated:["reactive"] ~long:"reactive" ~short:'r'
~in_help:InferCommand.([(Analyze, manual_generic)]) ~in_help:InferCommand.([(Analyze, manual_generic)])
"Reactive mode: the analysis starts from the files captured since the $(i,infer) command started" "Reactive mode: the analysis starts from the files captured since the $(i,infer) command \
started"
and reactive_capture = and reactive_capture =
@ -1687,7 +1756,9 @@ and report_hook =
~in_help:InferCommand.([(Analyze, manual_generic); (Run, manual_generic)]) ~in_help:InferCommand.([(Analyze, manual_generic); (Run, manual_generic)])
~default:(lib_dir ^/ "python" ^/ "report.py") ~default:(lib_dir ^/ "python" ^/ "report.py")
~meta:"script" ~meta:"script"
"Specify a script to be executed after the analysis results are written. This script will be passed, $(b,--issues-json), $(b,--issues-txt), $(b,--issues-xml), $(b,--project-root), and $(b,--results-dir)." "Specify a script to be executed after the analysis results are written. This script will be \
passed, $(b,--issues-json), $(b,--issues-txt), $(b,--issues-xml), $(b,--project-root), and \
$(b,--results-dir)."
and report_previous = and report_previous =
@ -1732,7 +1803,8 @@ and select =
and siof_safe_methods = and siof_safe_methods =
CLOpt.mk_string_list ~long:"siof-safe-methods" CLOpt.mk_string_list ~long:"siof-safe-methods"
~in_help:InferCommand.([(Analyze, manual_siof)]) ~in_help:InferCommand.([(Analyze, manual_siof)])
"Methods that are SIOF-safe; \"foo::bar\" will match \"foo::bar()\", \"foo<int>::bar()\", etc. (can be specified multiple times)" "Methods that are SIOF-safe; \"foo::bar\" will match \"foo::bar()\", \"foo<int>::bar()\", \
etc. (can be specified multiple times)"
and skip_analysis_in_path = and skip_analysis_in_path =
@ -1823,14 +1895,18 @@ and stacktrace =
CLOpt.mk_path_opt ~deprecated:["st"] ~long:"stacktrace" CLOpt.mk_path_opt ~deprecated:["st"] ~long:"stacktrace"
~in_help:InferCommand.([(Analyze, manual_crashcontext)]) ~in_help:InferCommand.([(Analyze, manual_crashcontext)])
~meta:"file" ~meta:"file"
"File path containing a json-encoded Java crash stacktrace. Used to guide the analysis (only with '-a crashcontext'). See tests/codetoanalyze/java/crashcontext/*.json for examples of the expected format." "File path containing a json-encoded Java crash stacktrace. Used to guide the analysis (only \
with '-a crashcontext'). See tests/codetoanalyze/java/crashcontext/*.json for examples of \
the expected format."
and stacktraces_dir = and stacktraces_dir =
CLOpt.mk_path_opt ~long:"stacktraces-dir" CLOpt.mk_path_opt ~long:"stacktraces-dir"
~in_help:InferCommand.([(Analyze, manual_crashcontext)]) ~in_help:InferCommand.([(Analyze, manual_crashcontext)])
~meta:"dir" ~meta:"dir"
"Directory path containing multiple json-encoded Java crash stacktraces. Used to guide the analysis (only with '-a crashcontext'). See tests/codetoanalyze/java/crashcontext/*.json for examples of the expected format." "Directory path containing multiple json-encoded Java crash stacktraces. Used to guide the \
analysis (only with '-a crashcontext'). See tests/codetoanalyze/java/crashcontext/*.json \
for examples of the expected format."
and stats_report = and stats_report =
@ -1879,7 +1955,8 @@ and trace_rearrange =
and tracing = and tracing =
CLOpt.mk_bool ~deprecated:["tracing"] ~long:"tracing" CLOpt.mk_bool ~deprecated:["tracing"] ~long:"tracing"
"Report error traces for runtime exceptions (Java only): generate preconditions for runtimeexceptions in Java and report errors for public methods which throw runtime exceptions" "Report error traces for runtime exceptions (Java only): generate preconditions for \
runtimeexceptions in Java and report errors for public methods which throw runtime exceptions"
and tv_commit = and tv_commit =
@ -1947,7 +2024,8 @@ and xcode_developer_dir =
and xcpretty = and xcpretty =
CLOpt.mk_bool ~long:"xcpretty" ~default:false CLOpt.mk_bool ~long:"xcpretty" ~default:false
~in_help:InferCommand.([(Capture, manual_clang)]) ~in_help:InferCommand.([(Capture, manual_clang)])
"Infer will use xcpretty together with xcodebuild to analyze an iOS app. xcpretty just needs to be in the path, infer command is still just $(i,`infer -- <xcodebuild command>`)." "Infer will use xcpretty together with xcodebuild to analyze an iOS app. xcpretty just needs \
to be in the path, infer command is still just $(i,`infer -- <xcodebuild command>`)."
(* The "rest" args must appear after "--" on the command line, and hence after other args, so they (* The "rest" args must appear after "--" on the command line, and hence after other args, so they
@ -1961,11 +2039,11 @@ let javac_classes_out =
needed but the tests break without this for now. See discussion in D4397716. *) needed but the tests break without this for now. See discussion in D4397716. *)
~default:CLOpt.init_work_dir ~default:CLOpt.init_work_dir
~f:(fun classes_out -> ~f:(fun classes_out ->
( if !buck then if !buck then (
let classes_out_infer = resolve classes_out ^/ buck_results_dir_name in let classes_out_infer = resolve classes_out ^/ buck_results_dir_name in
(* extend env var args to pass args to children that do not receive the rest args *) (* extend env var args to pass args to children that do not receive the rest args *)
CLOpt.extend_env_args ["--results-dir"; classes_out_infer] ; CLOpt.extend_env_args ["--results-dir"; classes_out_infer] ;
results_dir := classes_out_infer ) ; results_dir := classes_out_infer ) ;
classes_out ) classes_out )
"" ""
@ -1973,11 +2051,11 @@ let javac_classes_out =
and _ = and _ =
CLOpt.mk_string_opt ~parse_mode:CLOpt.Javac ~deprecated:["classpath"; "cp"] ~long:"" CLOpt.mk_string_opt ~parse_mode:CLOpt.Javac ~deprecated:["classpath"; "cp"] ~long:""
~f:(fun classpath -> ~f:(fun classpath ->
( if !buck then if !buck then (
let paths = String.split classpath ~on:':' in let paths = String.split classpath ~on:':' in
let files = List.filter paths ~f:(fun path -> Sys.is_file path = `Yes) in let files = List.filter paths ~f:(fun path -> Sys.is_file path = `Yes) in
CLOpt.extend_env_args (List.concat_map files ~f:(fun file -> ["--specs-library"; file])) ; CLOpt.extend_env_args (List.concat_map files ~f:(fun file -> ["--specs-library"; file])) ;
specs_library := List.rev_append files !specs_library ) ; specs_library := List.rev_append files !specs_library ) ;
classpath ) classpath )
"" ""
@ -2167,8 +2245,8 @@ let process_iphoneos_target_sdk_version_path_regex args =
{path= Str.regexp path; version} {path= Str.regexp path; version}
| None -> | None ->
L.(die UserError) L.(die UserError)
"Incorrect format for the option iphoneos-target-sdk_version-path-regex. The correct format is path:version but got %s" "Incorrect format for the option iphoneos-target-sdk_version-path-regex. The correct \
arg format is path:version but got %s" arg
in in
List.map ~f:process_iphoneos_target_sdk_version_path_regex args List.map ~f:process_iphoneos_target_sdk_version_path_regex args
@ -2182,8 +2260,8 @@ let process_linters_doc_url args =
{linter; doc_url} {linter; doc_url}
| None -> | None ->
L.(die UserError) L.(die UserError)
"Incorrect format for the option linters-doc-url. The correct format is linter:doc_url but got %s" "Incorrect format for the option linters-doc-url. The correct format is linter:doc_url \
arg but got %s" arg
in in
List.map ~f:linters_doc_url args List.map ~f:linters_doc_url args
@ -2664,7 +2742,10 @@ let clang_frontend_action_string =
let dynamic_dispatch = let dynamic_dispatch =
CLOpt.mk_bool ~long:"dynamic-dispatch" ~default:biabduction CLOpt.mk_bool ~long:"dynamic-dispatch" ~default:biabduction
"Specify treatment of dynamic dispatch in Java code: false 'none' treats dynamic dispatch as a call to unknown code and true triggers lazy dynamic dispatch. The latter mode follows the JVM semantics and creates procedure descriptions during symbolic execution using the type information found in the abstract state" "Specify treatment of dynamic dispatch in Java code: false 'none' treats dynamic dispatch as \
a call to unknown code and true triggers lazy dynamic dispatch. The latter mode follows the \
JVM semantics and creates procedure descriptions during symbolic execution using the type \
information found in the abstract state"
~in_help:InferCommand.([(Analyze, manual_java)]) ~in_help:InferCommand.([(Analyze, manual_java)])

@ -17,8 +17,8 @@ exception InferInternalError of string
exception InferUserError of string exception InferUserError of string
(** This can be used to avoid scattering exit invocations all over the codebase *)
exception InferExit of int exception InferExit of int
(** This can be used to avoid scattering exit invocations all over the codebase *)
(** kind of error for [die], with similar semantics as [Logging.{external,internal,user}_error] *) (** kind of error for [die], with similar semantics as [Logging.{external,internal,user}_error] *)
type error = ExternalError | InternalError | UserError type error = ExternalError | InternalError | UserError

@ -15,14 +15,14 @@ open! IStd
(** apply a map function for escape sequences *) (** apply a map function for escape sequences *)
let escape_map map_fun s = let escape_map map_fun s =
let needs_escape = String.exists ~f:(fun c -> Option.is_some (map_fun c)) s in let needs_escape = String.exists ~f:(fun c -> Option.is_some (map_fun c)) s in
if needs_escape then if needs_escape then (
let len = String.length s in let len = String.length s in
let buf = Buffer.create len in let buf = Buffer.create len in
for i = 0 to len - 1 do for i = 0 to len - 1 do
let c = String.unsafe_get s i in let c = String.unsafe_get s i in
match map_fun c with None -> Buffer.add_char buf c | Some s' -> Buffer.add_string buf s' match map_fun c with None -> Buffer.add_char buf c | Some s' -> Buffer.add_string buf s'
done ; done ;
Buffer.contents buf Buffer.contents buf )
else (* not escaping anything, so don't waste memory on a copy of the string *) else (* not escaping anything, so don't waste memory on a copy of the string *)
s s

@ -313,7 +313,9 @@ let setup_log_file () =
reset_formatters () ; reset_formatters () ;
if CLOpt.is_originator && preexisting_logfile then if CLOpt.is_originator && preexisting_logfile then
phase phase
"============================================================@\n= New infer execution begins@\n============================================================" "============================================================@\n\
= New infer execution begins@\n\
============================================================"
(** type of printable elements *) (** type of printable elements *)

@ -21,4 +21,3 @@ val start_child : f:('a -> unit) -> pool:t -> 'a -> unit
val wait_all : t -> unit val wait_all : t -> unit
(** Wait until all the currently executing processes terminate *) (** Wait until all the currently executing processes terminate *)

@ -6,5 +6,6 @@
* LICENSE file in the root directory of this source tree. An additional grant * LICENSE file in the root directory of this source tree. An additional grant
* of patent rights can be found in the PATENTS file in the same directory. * of patent rights can be found in the PATENTS file in the same directory.
*) *)
val in_child : bool ref val in_child : bool ref
(** Keep track of whether the current execution is in a child process *) (** Keep track of whether the current execution is in a child process *)

@ -43,8 +43,9 @@ let remove_results_dir () =
if not Config.force_delete_results_dir then if not Config.force_delete_results_dir then
Result.iter_error (is_results_dir ~check_correct_version:false ()) ~f:(fun err -> Result.iter_error (is_results_dir ~check_correct_version:false ()) ~f:(fun err ->
L.(die UserError) L.(die UserError)
"ERROR: '%s' exists but does not seem to be an infer results directory: %s@\nERROR: Please delete '%s' and try again@." "ERROR: '%s' exists but does not seem to be an infer results directory: %s@\n\
Config.results_dir err Config.results_dir ) ; ERROR: Please delete '%s' and try again@." Config.results_dir err Config.results_dir
) ;
Utils.rmtree Config.results_dir ) ; Utils.rmtree Config.results_dir ) ;
RunState.reset () RunState.reset ()

@ -45,8 +45,10 @@ let load_and_validate () =
(fun err_msg -> (fun err_msg ->
Error Error
(Printf.sprintf (Printf.sprintf
"Incompatible results directory '%s':\n%s\nWas '%s' created using an older version of infer?" "Incompatible results directory '%s':\n\
Config.results_dir err_msg Config.results_dir) ) %s\n\
Was '%s' created using an older version of infer?" Config.results_dir err_msg
Config.results_dir) )
msg msg
in in
if Sys.file_exists state_file_path <> `Yes then error "save state not found" if Sys.file_exists state_file_path <> `Yes then error "save state not found"

@ -47,13 +47,15 @@ let create_serializer (key: Key.t) : 'a serializer =
let read_data ((key': Key.t), (version': int), (value: 'a)) source_msg = let read_data ((key': Key.t), (version': int), (value: 'a)) source_msg =
if key <> key' then ( if key <> key' then (
L.user_error L.user_error
"Wrong key in when loading data from %s -- are you running infer with results coming from a previous version of infer?@\n" "Wrong key in when loading data from %s -- are you running infer with results coming from \
source_msg ; a previous version of infer?@\n\
" source_msg ;
None ) None )
else if version <> version' then ( else if version <> version' then (
L.user_error L.user_error
"Wrong version in when loading data from %s -- are you running infer with results coming from a previous version of infer?@\n" "Wrong version in when loading data from %s -- are you running infer with results coming \
source_msg ; from a previous version of infer?@\n\
" source_msg ;
None ) None )
else Some value else Some value
in in

@ -9,8 +9,8 @@
open! IStd open! IStd
(** The functions in this module tend to raise more often than their counterparts in [Sqlite3]. In particular, they may raise if the [Sqlite3.Rc.t] result of certain operations is unexpected. *)
exception Error of string exception Error of string
(** The functions in this module tend to raise more often than their counterparts in [Sqlite3]. In particular, they may raise if the [Sqlite3.Rc.t] result of certain operations is unexpected. *)
val check_sqlite_error : ?fatal:bool -> Sqlite3.db -> log:string -> Sqlite3.Rc.t -> unit val check_sqlite_error : ?fatal:bool -> Sqlite3.db -> log:string -> Sqlite3.Rc.t -> unit
(** Assert that the result is either [Sqlite3.Rc.OK]. If [row_is_ok] then [Sqlite3.Rc.ROW] is also accepted. If the result is not valid, then if [fatal] is set raise [Error], otherwise log the error and proceed. *) (** Assert that the result is either [Sqlite3.Rc.OK]. If [row_is_ok] then [Sqlite3.Rc.ROW] is also accepted. If the result is not valid, then if [fatal] is set raise [Error], otherwise log the error and proceed. *)

@ -19,8 +19,8 @@ type failure_kind =
| FKrecursion_timeout of int (** max recursion level exceeded *) | FKrecursion_timeout of int (** max recursion level exceeded *)
| FKcrash of string (** uncaught exception or failed assertion *) | FKcrash of string (** uncaught exception or failed assertion *)
(** failure that prevented analysis from finishing *)
exception Analysis_failure_exe of failure_kind exception Analysis_failure_exe of failure_kind
(** failure that prevented analysis from finishing *)
let exn_not_failure = function Analysis_failure_exe _ -> false | _ -> true let exn_not_failure = function Analysis_failure_exe _ -> false | _ -> true

@ -61,7 +61,8 @@ type failure_kind =
| FKrecursion_timeout of int (** max recursion level exceeded *) | FKrecursion_timeout of int (** max recursion level exceeded *)
| FKcrash of string (** uncaught exception or failed assertion *) | FKcrash of string (** uncaught exception or failed assertion *)
exception Analysis_failure_exe of failure_kind (** Timeout exception *) (** Timeout exception *)
exception Analysis_failure_exe of failure_kind
val exn_not_failure : exn -> bool val exn_not_failure : exn -> bool
(** check that the exception is not a timeout exception *) (** check that the exception is not a timeout exception *)

@ -24,29 +24,29 @@ module ArrInfo = struct
let make : Itv.t * Itv.t * Itv.t -> t = fun (o, s, stride) -> {offset= o; size= s; stride} let make : Itv.t * Itv.t * Itv.t -> t = fun (o, s, stride) -> {offset= o; size= s; stride}
let join : t -> t -> t = let join : t -> t -> t =
fun a1 a2 -> fun a1 a2 ->
if phys_equal a1 a2 then a2 if phys_equal a1 a2 then a2
else else
{ offset= Itv.join a1.offset a2.offset { offset= Itv.join a1.offset a2.offset
; size= Itv.join a1.size a2.size ; size= Itv.join a1.size a2.size
; stride= Itv.join a1.stride a2.stride } ; stride= Itv.join a1.stride a2.stride }
let widen : prev:t -> next:t -> num_iters:int -> t = let widen : prev:t -> next:t -> num_iters:int -> t =
fun ~prev ~next ~num_iters -> fun ~prev ~next ~num_iters ->
if phys_equal prev next then next if phys_equal prev next then next
else else
{ offset= Itv.widen ~prev:prev.offset ~next:next.offset ~num_iters { offset= Itv.widen ~prev:prev.offset ~next:next.offset ~num_iters
; size= Itv.widen ~prev:prev.size ~next:next.size ~num_iters ; size= Itv.widen ~prev:prev.size ~next:next.size ~num_iters
; stride= Itv.widen ~prev:prev.stride ~next:next.stride ~num_iters } ; stride= Itv.widen ~prev:prev.stride ~next:next.stride ~num_iters }
let ( <= ) : lhs:t -> rhs:t -> bool = let ( <= ) : lhs:t -> rhs:t -> bool =
fun ~lhs ~rhs -> fun ~lhs ~rhs ->
if phys_equal lhs rhs then true if phys_equal lhs rhs then true
else else
Itv.le ~lhs:lhs.offset ~rhs:rhs.offset && Itv.le ~lhs:lhs.size ~rhs:rhs.size Itv.le ~lhs:lhs.offset ~rhs:rhs.offset && Itv.le ~lhs:lhs.size ~rhs:rhs.size
&& Itv.le ~lhs:lhs.stride ~rhs:rhs.stride && Itv.le ~lhs:lhs.stride ~rhs:rhs.stride
let plus_offset : t -> Itv.t -> t = fun arr i -> {arr with offset= Itv.plus arr.offset i} let plus_offset : t -> Itv.t -> t = fun arr i -> {arr with offset= Itv.plus arr.offset i}
@ -56,35 +56,35 @@ module ArrInfo = struct
let diff : t -> t -> Itv.astate = fun arr1 arr2 -> Itv.minus arr1.offset arr2.offset let diff : t -> t -> Itv.astate = fun arr1 arr2 -> Itv.minus arr1.offset arr2.offset
let subst : t -> Itv.Bound.t bottom_lifted Itv.SubstMap.t -> t = let subst : t -> Itv.Bound.t bottom_lifted Itv.SubstMap.t -> t =
fun arr subst_map -> fun arr subst_map ->
{arr with offset= Itv.subst arr.offset subst_map; size= Itv.subst arr.size subst_map} {arr with offset= Itv.subst arr.offset subst_map; size= Itv.subst arr.size subst_map}
let pp : Format.formatter -> t -> unit = let pp : Format.formatter -> t -> unit =
fun fmt arr -> Format.fprintf fmt "offset : %a, size : %a" Itv.pp arr.offset Itv.pp arr.size fun fmt arr -> Format.fprintf fmt "offset : %a, size : %a" Itv.pp arr.offset Itv.pp arr.size
let get_symbols : t -> Itv.Symbol.t list = let get_symbols : t -> Itv.Symbol.t list =
fun arr -> fun arr ->
let s1 = Itv.get_symbols arr.offset in let s1 = Itv.get_symbols arr.offset in
let s2 = Itv.get_symbols arr.size in let s2 = Itv.get_symbols arr.size in
let s3 = Itv.get_symbols arr.stride in let s3 = Itv.get_symbols arr.stride in
List.concat [s1; s2; s3] List.concat [s1; s2; s3]
let normalize : t -> t = let normalize : t -> t =
fun arr -> fun arr ->
{ offset= Itv.normalize arr.offset { offset= Itv.normalize arr.offset
; size= Itv.normalize arr.size ; size= Itv.normalize arr.size
; stride= Itv.normalize arr.stride } ; stride= Itv.normalize arr.stride }
let prune_comp : Binop.t -> t -> t -> t = let prune_comp : Binop.t -> t -> t -> t =
fun c arr1 arr2 -> {arr1 with offset= Itv.prune_comp c arr1.offset arr2.offset} fun c arr1 arr2 -> {arr1 with offset= Itv.prune_comp c arr1.offset arr2.offset}
let prune_eq : t -> t -> t = let prune_eq : t -> t -> t =
fun arr1 arr2 -> {arr1 with offset= Itv.prune_eq arr1.offset arr2.offset} fun arr1 arr2 -> {arr1 with offset= Itv.prune_eq arr1.offset arr2.offset}
let set_size : Itv.t -> t -> t = fun size arr -> {arr with size} let set_size : Itv.t -> t -> t = fun size arr -> {arr with size}
@ -99,7 +99,7 @@ let unknown : astate = add Allocsite.unknown ArrInfo.top bot
let is_bot : astate -> bool = is_empty let is_bot : astate -> bool = is_empty
let make : Allocsite.t -> Itv.t -> Itv.t -> Itv.t -> astate = let make : Allocsite.t -> Itv.t -> Itv.t -> Itv.t -> astate =
fun a o sz st -> add a (ArrInfo.make (o, sz, st)) bot fun a o sz st -> add a (ArrInfo.make (o, sz, st)) bot
let offsetof : astate -> Itv.t = fun a -> fold (fun _ arr -> Itv.join arr.ArrInfo.offset) a Itv.bot let offsetof : astate -> Itv.t = fun a -> fold (fun _ arr -> Itv.join arr.ArrInfo.offset) a Itv.bot
@ -107,51 +107,51 @@ let offsetof : astate -> Itv.t = fun a -> fold (fun _ arr -> Itv.join arr.ArrInf
let sizeof : astate -> Itv.t = fun a -> fold (fun _ arr -> Itv.join arr.ArrInfo.size) a Itv.bot let sizeof : astate -> Itv.t = fun a -> fold (fun _ arr -> Itv.join arr.ArrInfo.size) a Itv.bot
let plus_offset : astate -> Itv.t -> astate = let plus_offset : astate -> Itv.t -> astate =
fun arr i -> map (fun a -> ArrInfo.plus_offset a i) arr fun arr i -> map (fun a -> ArrInfo.plus_offset a i) arr
let minus_offset : astate -> Itv.t -> astate = let minus_offset : astate -> Itv.t -> astate =
fun arr i -> map (fun a -> ArrInfo.minus_offset a i) arr fun arr i -> map (fun a -> ArrInfo.minus_offset a i) arr
let diff : astate -> astate -> Itv.t = let diff : astate -> astate -> Itv.t =
fun arr1 arr2 -> fun arr1 arr2 ->
let diff_join k a2 acc = let diff_join k a2 acc =
match find k arr1 with match find k arr1 with
| a1 -> | a1 ->
Itv.join acc (ArrInfo.diff a1 a2) Itv.join acc (ArrInfo.diff a1 a2)
| exception Not_found -> | exception Not_found ->
Itv.top Itv.top
in in
fold diff_join arr2 Itv.bot fold diff_join arr2 Itv.bot
let get_pow_loc : astate -> PowLoc.t = let get_pow_loc : astate -> PowLoc.t =
fun array -> fun array ->
let pow_loc_of_allocsite k _ acc = PowLoc.add (Loc.of_allocsite k) acc in let pow_loc_of_allocsite k _ acc = PowLoc.add (Loc.of_allocsite k) acc in
fold pow_loc_of_allocsite array PowLoc.bot fold pow_loc_of_allocsite array PowLoc.bot
let subst : astate -> Itv.Bound.t bottom_lifted Itv.SubstMap.t -> astate = let subst : astate -> Itv.Bound.t bottom_lifted Itv.SubstMap.t -> astate =
fun a subst_map -> map (fun info -> ArrInfo.subst info subst_map) a fun a subst_map -> map (fun info -> ArrInfo.subst info subst_map) a
let get_symbols : astate -> Itv.Symbol.t list = let get_symbols : astate -> Itv.Symbol.t list =
fun a -> List.concat_map ~f:(fun (_, ai) -> ArrInfo.get_symbols ai) (bindings a) fun a -> List.concat_map ~f:(fun (_, ai) -> ArrInfo.get_symbols ai) (bindings a)
let normalize : astate -> astate = fun a -> map ArrInfo.normalize a let normalize : astate -> astate = fun a -> map ArrInfo.normalize a
let do_prune : (ArrInfo.t -> ArrInfo.t -> ArrInfo.t) -> astate -> astate -> astate = let do_prune : (ArrInfo.t -> ArrInfo.t -> ArrInfo.t) -> astate -> astate -> astate =
fun arr_info_prune a1 a2 -> fun arr_info_prune a1 a2 ->
if Int.equal (cardinal a2) 1 then if Int.equal (cardinal a2) 1 then
let k, v2 = choose a2 in let k, v2 = choose a2 in
if mem k a1 then add k (arr_info_prune (find k a1) v2) a1 else a1 if mem k a1 then add k (arr_info_prune (find k a1) v2) a1 else a1
else a1 else a1
let prune_comp : Binop.t -> astate -> astate -> astate = let prune_comp : Binop.t -> astate -> astate -> astate =
fun c a1 a2 -> do_prune (ArrInfo.prune_comp c) a1 a2 fun c a1 a2 -> do_prune (ArrInfo.prune_comp c) a1 a2
let prune_eq : astate -> astate -> astate = fun a1 a2 -> do_prune ArrInfo.prune_eq a1 a2 let prune_eq : astate -> astate -> astate = fun a1 a2 -> do_prune ArrInfo.prune_eq a1 a2

@ -41,84 +41,82 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let declare_symbolic_val let declare_symbolic_val
: Typ.Procname.t -> Tenv.t -> CFG.node -> Location.t -> Loc.t -> Typ.typ -> inst_num:int : Typ.Procname.t -> Tenv.t -> CFG.node -> Location.t -> Loc.t -> Typ.typ -> inst_num:int
-> new_sym_num:(unit -> int) -> Domain.t -> Domain.t = -> new_sym_num:(unit -> int) -> Domain.t -> Domain.t =
fun pname tenv node location loc typ ~inst_num ~new_sym_num mem -> fun pname tenv node location loc typ ~inst_num ~new_sym_num mem ->
let max_depth = 2 in let max_depth = 2 in
let new_alloc_num = BoUtils.counter_gen 1 in let new_alloc_num = BoUtils.counter_gen 1 in
let rec decl_sym_val pname tenv node location ~depth ~is_last_field loc typ mem = let rec decl_sym_val pname tenv node location ~depth ~is_last_field loc typ mem =
if depth > max_depth then mem if depth > max_depth then mem
else else
let depth = depth + 1 in let depth = depth + 1 in
match typ.Typ.desc with match typ.Typ.desc with
| Typ.Tint ikind -> | Typ.Tint ikind ->
let unsigned = Typ.ikind_is_unsigned ikind in let unsigned = Typ.ikind_is_unsigned ikind in
let v = let v =
Dom.Val.make_sym ~unsigned pname new_sym_num Dom.Val.make_sym ~unsigned pname new_sym_num
|> Dom.Val.add_trace_elem (Trace.SymAssign location) |> Dom.Val.add_trace_elem (Trace.SymAssign location)
in in
Dom.Mem.add_heap loc v mem Dom.Mem.add_heap loc v mem
| Typ.Tfloat _ -> | Typ.Tfloat _ ->
let v = let v =
Dom.Val.make_sym pname new_sym_num Dom.Val.make_sym pname new_sym_num
|> Dom.Val.add_trace_elem (Trace.SymAssign location) |> Dom.Val.add_trace_elem (Trace.SymAssign location)
in
Dom.Mem.add_heap loc v mem
| Typ.Tptr (typ, _) ->
BoUtils.Exec.decl_sym_arr
~decl_sym_val:(decl_sym_val ~is_last_field:false)
pname tenv node location ~depth loc typ ~inst_num ~new_sym_num ~new_alloc_num mem
| Typ.Tarray {elt; length} ->
let size =
match length with
| Some length when is_last_field && (IntLit.iszero length || IntLit.isone length) ->
Some (Itv.make_sym pname new_sym_num)
| _ ->
Option.map ~f:Itv.of_int_lit length
in
let offset = Itv.zero in
BoUtils.Exec.decl_sym_arr
~decl_sym_val:(decl_sym_val ~is_last_field:false)
pname tenv node location ~depth loc elt ~offset ?size ~inst_num ~new_sym_num
~new_alloc_num mem
| Typ.Tstruct typename -> (
match Models.TypName.dispatch typename with
| Some {Models.declare_symbolic} ->
let model_env = Models.mk_model_env pname node location tenv in
declare_symbolic ~decl_sym_val:(decl_sym_val ~is_last_field) model_env ~depth loc
~inst_num ~new_sym_num ~new_alloc_num mem
| None ->
let decl_fld ~is_last_field mem (fn, typ, _) =
let loc_fld = Loc.append_field loc ~fn in
decl_sym_val pname tenv node location ~depth loc_fld typ ~is_last_field mem
in in
Dom.Mem.add_heap loc v mem let decl_flds str =
| Typ.Tptr (typ, _) -> IList.fold_last ~f:(decl_fld ~is_last_field:false)
BoUtils.Exec.decl_sym_arr ~f_last:(decl_fld ~is_last_field) ~init:mem str.Typ.Struct.fields
~decl_sym_val:(decl_sym_val ~is_last_field:false)
pname tenv node location ~depth loc typ ~inst_num ~new_sym_num ~new_alloc_num mem
| Typ.Tarray {elt; length} ->
let size =
match length with
| Some length when is_last_field && (IntLit.iszero length || IntLit.isone length) ->
Some (Itv.make_sym pname new_sym_num)
| _ ->
Option.map ~f:Itv.of_int_lit length
in in
let offset = Itv.zero in let opt_struct = Tenv.lookup tenv typename in
BoUtils.Exec.decl_sym_arr Option.value_map opt_struct ~default:mem ~f:decl_flds )
~decl_sym_val:(decl_sym_val ~is_last_field:false) | _ ->
pname tenv node location ~depth loc elt ~offset ?size ~inst_num ~new_sym_num if Config.bo_debug >= 3 then
~new_alloc_num mem L.(debug BufferOverrun Verbose)
| Typ.Tstruct typename -> ( "/!\\ decl_fld of unhandled type: %a at %a@." (Typ.pp Pp.text) typ Location.pp
match Models.TypName.dispatch typename with (CFG.loc node) ;
| Some {Models.declare_symbolic} -> mem
let model_env = Models.mk_model_env pname node location tenv in in
declare_symbolic ~decl_sym_val:(decl_sym_val ~is_last_field) model_env ~depth loc decl_sym_val pname tenv node location ~depth:0 ~is_last_field:false loc typ mem
~inst_num ~new_sym_num ~new_alloc_num mem
| None ->
let decl_fld ~is_last_field mem (fn, typ, _) =
let loc_fld = Loc.append_field loc ~fn in
decl_sym_val pname tenv node location ~depth loc_fld typ ~is_last_field mem
in
let decl_flds str =
IList.fold_last ~f:(decl_fld ~is_last_field:false)
~f_last:(decl_fld ~is_last_field) ~init:mem str.Typ.Struct.fields
in
let opt_struct = Tenv.lookup tenv typename in
Option.value_map opt_struct ~default:mem ~f:decl_flds )
| _ ->
if Config.bo_debug >= 3 then
L.(debug BufferOverrun Verbose)
"/!\\ decl_fld of unhandled type: %a at %a@." (Typ.pp Pp.text) typ Location.pp
(CFG.loc node) ;
mem
in
decl_sym_val pname tenv node location ~depth:0 ~is_last_field:false loc typ mem
let declare_symbolic_parameters let declare_symbolic_parameters
: Typ.Procname.t -> Tenv.t -> CFG.node -> Location.t -> inst_num:int -> (Pvar.t * Typ.t) list : Typ.Procname.t -> Tenv.t -> CFG.node -> Location.t -> inst_num:int -> (Pvar.t * Typ.t) list
-> Dom.Mem.astate -> Dom.Mem.astate = -> Dom.Mem.astate -> Dom.Mem.astate =
fun pname tenv node location ~inst_num formals mem -> fun pname tenv node location ~inst_num formals mem ->
let new_sym_num = BoUtils.counter_gen 0 in let new_sym_num = BoUtils.counter_gen 0 in
let add_formal (mem, inst_num) (pvar, typ) = let add_formal (mem, inst_num) (pvar, typ) =
let loc = Loc.of_pvar pvar in let loc = Loc.of_pvar pvar in
let mem = let mem = declare_symbolic_val pname tenv node location loc typ ~inst_num ~new_sym_num mem in
declare_symbolic_val pname tenv node location loc typ ~inst_num ~new_sym_num mem (mem, inst_num + 1)
in in
(mem, inst_num + 1) List.fold ~f:add_formal ~init:(mem, inst_num) formals |> fst
in
List.fold ~f:add_formal ~init:(mem, inst_num) formals |> fst
let instantiate_ret ret callee_pname callee_exit_mem subst_map mem ret_alias location = let instantiate_ret ret callee_pname callee_exit_mem subst_map mem ret_alias location =
@ -177,120 +175,119 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let instantiate_mem let instantiate_mem
: Tenv.t -> (Ident.t * Typ.t) option -> Procdesc.t option -> Typ.Procname.t : Tenv.t -> (Ident.t * Typ.t) option -> Procdesc.t option -> Typ.Procname.t
-> (Exp.t * Typ.t) list -> Dom.Mem.astate -> Dom.Summary.t -> Location.t -> Dom.Mem.astate = -> (Exp.t * Typ.t) list -> Dom.Mem.astate -> Dom.Summary.t -> Location.t -> Dom.Mem.astate =
fun tenv ret callee_pdesc callee_pname params caller_mem summary location -> fun tenv ret callee_pdesc callee_pname params caller_mem summary location ->
let callee_entry_mem = Dom.Summary.get_input summary in let callee_entry_mem = Dom.Summary.get_input summary in
let callee_exit_mem = Dom.Summary.get_output summary in let callee_exit_mem = Dom.Summary.get_output summary in
let callee_ret_alias = Dom.Mem.find_ret_alias callee_exit_mem in let callee_ret_alias = Dom.Mem.find_ret_alias callee_exit_mem in
match callee_pdesc with match callee_pdesc with
| Some pdesc -> | Some pdesc ->
let subst_map, ret_alias = let subst_map, ret_alias =
Sem.get_subst_map tenv pdesc params caller_mem callee_entry_mem ~callee_ret_alias Sem.get_subst_map tenv pdesc params caller_mem callee_entry_mem ~callee_ret_alias
in in
instantiate_ret ret callee_pname callee_exit_mem subst_map caller_mem ret_alias location instantiate_ret ret callee_pname callee_exit_mem subst_map caller_mem ret_alias location
|> instantiate_param tenv pdesc params callee_entry_mem callee_exit_mem subst_map |> instantiate_param tenv pdesc params callee_entry_mem callee_exit_mem subst_map location
location | None ->
| None -> caller_mem
caller_mem
let print_debug_info : Sil.instr -> Dom.Mem.astate -> Dom.Mem.astate -> unit = let print_debug_info : Sil.instr -> Dom.Mem.astate -> Dom.Mem.astate -> unit =
fun instr pre post -> fun instr pre post ->
L.(debug BufferOverrun Verbose) "@\n@\n================================@\n" ; L.(debug BufferOverrun Verbose) "@\n@\n================================@\n" ;
L.(debug BufferOverrun Verbose) "@[<v 2>Pre-state : @,%a" Dom.Mem.pp pre ; L.(debug BufferOverrun Verbose) "@[<v 2>Pre-state : @,%a" Dom.Mem.pp pre ;
L.(debug BufferOverrun Verbose) "@]@\n@\n%a" (Sil.pp_instr Pp.text) instr ; L.(debug BufferOverrun Verbose) "@]@\n@\n%a" (Sil.pp_instr Pp.text) instr ;
L.(debug BufferOverrun Verbose) "@\n@\n" ; L.(debug BufferOverrun Verbose) "@\n@\n" ;
L.(debug BufferOverrun Verbose) "@[<v 2>Post-state : @,%a" Dom.Mem.pp post ; L.(debug BufferOverrun Verbose) "@[<v 2>Post-state : @,%a" Dom.Mem.pp post ;
L.(debug BufferOverrun Verbose) "@]@\n" ; L.(debug BufferOverrun Verbose) "@]@\n" ;
L.(debug BufferOverrun Verbose) "================================@\n@." L.(debug BufferOverrun Verbose) "================================@\n@."
let exec_instr : Dom.Mem.astate -> extras ProcData.t -> CFG.node -> Sil.instr -> Dom.Mem.astate = let exec_instr : Dom.Mem.astate -> extras ProcData.t -> CFG.node -> Sil.instr -> Dom.Mem.astate =
fun mem {pdesc; tenv; extras} node instr -> fun mem {pdesc; tenv; extras} node instr ->
let pname = Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
let output_mem = let output_mem =
match instr with match instr with
| Load (id, _, _, _) when Ident.is_none id -> | Load (id, _, _, _) when Ident.is_none id ->
mem mem
| Load (id, exp, _, _) -> | Load (id, exp, _, _) ->
BoUtils.Exec.load_val id (Sem.eval exp mem) mem BoUtils.Exec.load_val id (Sem.eval exp mem) mem
| Store (exp1, _, exp2, location) -> | Store (exp1, _, exp2, location) ->
let locs = Sem.eval exp1 mem |> Dom.Val.get_all_locs in let locs = Sem.eval exp1 mem |> Dom.Val.get_all_locs in
let v = Sem.eval exp2 mem |> Dom.Val.add_trace_elem (Trace.Assign location) in let v = Sem.eval exp2 mem |> Dom.Val.add_trace_elem (Trace.Assign location) in
let mem = Dom.Mem.update_mem locs v mem in let mem = Dom.Mem.update_mem locs v mem in
let mem = let mem =
if PowLoc.is_singleton locs then if PowLoc.is_singleton locs then
let loc_v = PowLoc.min_elt locs in let loc_v = PowLoc.min_elt locs in
match Typ.Procname.get_method pname with match Typ.Procname.get_method pname with
| "__inferbo_empty" when Loc.is_return loc_v -> ( | "__inferbo_empty" when Loc.is_return loc_v -> (
match Sem.get_formals pdesc with match Sem.get_formals pdesc with
| [(formal, _)] -> | [(formal, _)] ->
let formal_v = Dom.Mem.find_heap (Loc.of_pvar formal) mem in let formal_v = Dom.Mem.find_heap (Loc.of_pvar formal) mem in
Dom.Mem.store_empty_alias formal_v loc_v exp2 mem Dom.Mem.store_empty_alias formal_v loc_v exp2 mem
| _ ->
assert false )
| _ -> | _ ->
Dom.Mem.store_simple_alias loc_v exp2 mem assert false )
else mem | _ ->
in Dom.Mem.store_simple_alias loc_v exp2 mem
let mem = Dom.Mem.update_latest_prune exp1 exp2 mem in else mem
mem in
| Prune (exp, _, _, _) -> let mem = Dom.Mem.update_latest_prune exp1 exp2 mem in
Sem.prune exp mem mem
| Call (ret, Const Cfun callee_pname, params, location, _) | Prune (exp, _, _, _) ->
-> ( Sem.prune exp mem
let model_env = Models.mk_model_env callee_pname node location tenv ?ret in | Call (ret, Const Cfun callee_pname, params, location, _)
match Models.Procname.dispatch callee_pname params with -> (
| Some {Models.exec} -> let model_env = Models.mk_model_env callee_pname node location tenv ?ret in
exec model_env mem match Models.Procname.dispatch callee_pname params with
| Some {Models.exec} ->
exec model_env mem
| None ->
match Summary.read_summary pdesc callee_pname with
| Some summary ->
let callee = extras callee_pname in
instantiate_mem tenv ret callee callee_pname params mem summary location
| None -> | None ->
match Summary.read_summary pdesc callee_pname with L.(debug BufferOverrun Verbose)
| Some summary -> "/!\\ Unknown call to %a at %a@\n" Typ.Procname.pp callee_pname Location.pp
let callee = extras callee_pname in location ;
instantiate_mem tenv ret callee callee_pname params mem summary location Models.model_by_value Dom.Val.unknown model_env mem
|> Dom.Mem.add_heap Loc.unknown Dom.Val.unknown )
| Declare_locals (locals, location) ->
(* array allocation in stack e.g., int arr[10] *)
let rec decl_local pname node location loc typ ~inst_num ~dimension mem =
match typ.Typ.desc with
| Typ.Tarray {elt= typ; length; stride} ->
let stride = Option.map ~f:IntLit.to_int stride in
BoUtils.Exec.decl_local_array ~decl_local pname node location loc typ ~length
?stride ~inst_num ~dimension mem
| Typ.Tstruct typname -> (
match Models.TypName.dispatch typname with
| Some {Models.declare_local} ->
let model_env = Models.mk_model_env pname node location tenv in
declare_local ~decl_local model_env loc ~inst_num ~dimension mem
| None -> | None ->
L.(debug BufferOverrun Verbose) (mem, inst_num) )
"/!\\ Unknown call to %a at %a@\n" Typ.Procname.pp callee_pname Location.pp | _ ->
location ; (mem, inst_num)
Models.model_by_value Dom.Val.unknown model_env mem in
|> Dom.Mem.add_heap Loc.unknown Dom.Val.unknown ) let try_decl_local (mem, inst_num) (pvar, typ) =
| Declare_locals (locals, location) -> let loc = Loc.of_pvar pvar in
(* array allocation in stack e.g., int arr[10] *) decl_local pname node location loc typ ~inst_num ~dimension:1 mem
let rec decl_local pname node location loc typ ~inst_num ~dimension mem = in
match typ.Typ.desc with let mem, inst_num = List.fold ~f:try_decl_local ~init:(mem, 1) locals in
| Typ.Tarray {elt= typ; length; stride} -> let formals = Sem.get_formals pdesc in
let stride = Option.map ~f:IntLit.to_int stride in declare_symbolic_parameters pname tenv node location ~inst_num formals mem
BoUtils.Exec.decl_local_array ~decl_local pname node location loc typ ~length | Call (_, fun_exp, _, location, _) ->
?stride ~inst_num ~dimension mem let () =
| Typ.Tstruct typname -> ( L.(debug BufferOverrun Verbose)
match Models.TypName.dispatch typname with "/!\\ Call to non-const function %a at %a" Exp.pp fun_exp Location.pp location
| Some {Models.declare_local} -> in
let model_env = Models.mk_model_env pname node location tenv in mem
declare_local ~decl_local model_env loc ~inst_num ~dimension mem | Remove_temps (temps, _) ->
| None -> Dom.Mem.remove_temps temps mem
(mem, inst_num) ) | Abstract _ | Nullify _ ->
| _ -> mem
(mem, inst_num) in
in print_debug_info instr mem output_mem ;
let try_decl_local (mem, inst_num) (pvar, typ) = output_mem
let loc = Loc.of_pvar pvar in
decl_local pname node location loc typ ~inst_num ~dimension:1 mem
in
let mem, inst_num = List.fold ~f:try_decl_local ~init:(mem, 1) locals in
let formals = Sem.get_formals pdesc in
declare_symbolic_parameters pname tenv node location ~inst_num formals mem
| Call (_, fun_exp, _, location, _) ->
let () =
L.(debug BufferOverrun Verbose)
"/!\\ Call to non-const function %a at %a" Exp.pp fun_exp Location.pp location
in
mem
| Remove_temps (temps, _) ->
Dom.Mem.remove_temps temps mem
| Abstract _ | Nullify _ ->
mem
in
print_debug_info instr mem output_mem ;
output_mem
end end
module Analyzer = AbstractInterpreter.Make (ProcCfg.Normal) (TransferFunctions) module Analyzer = AbstractInterpreter.Make (ProcCfg.Normal) (TransferFunctions)
@ -308,55 +305,55 @@ module Report = struct
let add_condition let add_condition
: Typ.Procname.t -> Exp.t -> Location.t -> Dom.Mem.astate -> PO.ConditionSet.t : Typ.Procname.t -> Exp.t -> Location.t -> Dom.Mem.astate -> PO.ConditionSet.t
-> PO.ConditionSet.t = -> PO.ConditionSet.t =
fun pname exp location mem cond_set -> fun pname exp location mem cond_set ->
match exp with match exp with
| Exp.Var _ -> | Exp.Var _ ->
let v = Sem.eval exp mem in let v = Sem.eval exp mem in
let arr = Dom.Val.get_array_blk v in let arr = Dom.Val.get_array_blk v in
let arr_traces = Dom.Val.get_traces v in let arr_traces = Dom.Val.get_traces v in
BoUtils.Check.array_access ~arr ~arr_traces ~idx:Itv.zero ~idx_traces:TraceSet.empty BoUtils.Check.array_access ~arr ~arr_traces ~idx:Itv.zero ~idx_traces:TraceSet.empty
~is_plus:true pname location cond_set ~is_plus:true pname location cond_set
| Exp.Lindex (array_exp, index_exp) -> | Exp.Lindex (array_exp, index_exp) ->
BoUtils.Check.lindex ~array_exp ~index_exp mem pname location cond_set BoUtils.Check.lindex ~array_exp ~index_exp mem pname location cond_set
| Exp.BinOp ((Binop.PlusA as bop), e1, e2) | Exp.BinOp ((Binop.MinusA as bop), e1, e2) -> | Exp.BinOp ((Binop.PlusA as bop), e1, e2) | Exp.BinOp ((Binop.MinusA as bop), e1, e2) ->
let v_arr = Sem.eval e1 mem in let v_arr = Sem.eval e1 mem in
let arr = Dom.Val.get_array_blk v_arr in let arr = Dom.Val.get_array_blk v_arr in
let arr_traces = Dom.Val.get_traces v_arr in let arr_traces = Dom.Val.get_traces v_arr in
let v_idx = Sem.eval e2 mem in let v_idx = Sem.eval e2 mem in
let idx = Dom.Val.get_itv v_idx in let idx = Dom.Val.get_itv v_idx in
let idx_traces = Dom.Val.get_traces v_idx in let idx_traces = Dom.Val.get_traces v_idx in
let is_plus = Binop.equal bop Binop.PlusA in let is_plus = Binop.equal bop Binop.PlusA in
BoUtils.Check.array_access ~arr ~arr_traces ~idx ~idx_traces ~is_plus pname location BoUtils.Check.array_access ~arr ~arr_traces ~idx ~idx_traces ~is_plus pname location
cond_set
| _ ->
cond_set cond_set
| _ ->
cond_set
let instantiate_cond let instantiate_cond
: Tenv.t -> Typ.Procname.t -> Procdesc.t option -> (Exp.t * Typ.t) list -> Dom.Mem.astate : Tenv.t -> Typ.Procname.t -> Procdesc.t option -> (Exp.t * Typ.t) list -> Dom.Mem.astate
-> Summary.payload -> Location.t -> PO.ConditionSet.t = -> Summary.payload -> Location.t -> PO.ConditionSet.t =
fun tenv caller_pname callee_pdesc params caller_mem summary location -> fun tenv caller_pname callee_pdesc params caller_mem summary location ->
let callee_entry_mem = Dom.Summary.get_input summary in let callee_entry_mem = Dom.Summary.get_input summary in
let callee_cond = Dom.Summary.get_cond_set summary in let callee_cond = Dom.Summary.get_cond_set summary in
match callee_pdesc with match callee_pdesc with
| Some pdesc -> | Some pdesc ->
let subst_map, _ = let subst_map, _ =
Sem.get_subst_map tenv pdesc params caller_mem callee_entry_mem ~callee_ret_alias:None Sem.get_subst_map tenv pdesc params caller_mem callee_entry_mem ~callee_ret_alias:None
in in
let pname = Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
PO.ConditionSet.subst callee_cond subst_map caller_pname pname location PO.ConditionSet.subst callee_cond subst_map caller_pname pname location
| _ -> | _ ->
callee_cond callee_cond
let print_debug_info : Sil.instr -> Dom.Mem.astate -> PO.ConditionSet.t -> unit = let print_debug_info : Sil.instr -> Dom.Mem.astate -> PO.ConditionSet.t -> unit =
fun instr pre cond_set -> fun instr pre cond_set ->
L.(debug BufferOverrun Verbose) "@\n@\n================================@\n" ; L.(debug BufferOverrun Verbose) "@\n@\n================================@\n" ;
L.(debug BufferOverrun Verbose) "@[<v 2>Pre-state : @,%a" Dom.Mem.pp pre ; L.(debug BufferOverrun Verbose) "@[<v 2>Pre-state : @,%a" Dom.Mem.pp pre ;
L.(debug BufferOverrun Verbose) "@]@\n@\n%a" (Sil.pp_instr Pp.text) instr ; L.(debug BufferOverrun Verbose) "@]@\n@\n%a" (Sil.pp_instr Pp.text) instr ;
L.(debug BufferOverrun Verbose) "@[<v 2>@\n@\n%a" PO.ConditionSet.pp cond_set ; L.(debug BufferOverrun Verbose) "@[<v 2>@\n@\n%a" PO.ConditionSet.pp cond_set ;
L.(debug BufferOverrun Verbose) "@]@\n" ; L.(debug BufferOverrun Verbose) "@]@\n" ;
L.(debug BufferOverrun Verbose) "================================@\n@." L.(debug BufferOverrun Verbose) "================================@\n@."
module ExitStatement = struct module ExitStatement = struct
@ -393,167 +390,165 @@ module Report = struct
let rec collect_instrs let rec collect_instrs
: Specs.summary -> extras ProcData.t -> CFG.node -> Sil.instr list -> Dom.Mem.astate : Specs.summary -> extras ProcData.t -> CFG.node -> Sil.instr list -> Dom.Mem.astate
-> PO.ConditionSet.t -> PO.ConditionSet.t = -> PO.ConditionSet.t -> PO.ConditionSet.t =
fun summary ({pdesc; tenv; extras} as pdata) node instrs mem cond_set -> fun summary ({pdesc; tenv; extras} as pdata) node instrs mem cond_set ->
match instrs with match instrs with
| [] -> | [] ->
cond_set cond_set
| instr :: rem_instrs -> | instr :: rem_instrs ->
let pname = Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
let cond_set = let cond_set =
match instr with match instr with
| Sil.Load (_, exp, _, location) | Sil.Store (exp, _, _, location) -> | Sil.Load (_, exp, _, location) | Sil.Store (exp, _, _, location) ->
add_condition pname exp location mem cond_set add_condition pname exp location mem cond_set
| Sil.Call (_, Const Cfun callee_pname, params, location, _) -> ( | Sil.Call (_, Const Cfun callee_pname, params, location, _) -> (
match Models.Procname.dispatch callee_pname params with match Models.Procname.dispatch callee_pname params with
| Some {Models.check} -> | Some {Models.check} ->
check (Models.mk_model_env pname node location tenv) mem cond_set check (Models.mk_model_env pname node location tenv) mem cond_set
| None -> | None ->
match Summary.read_summary pdesc callee_pname with match Summary.read_summary pdesc callee_pname with
| Some callee_summary -> | Some callee_summary ->
let callee = extras callee_pname in let callee = extras callee_pname in
instantiate_cond tenv pname callee params mem callee_summary location instantiate_cond tenv pname callee params mem callee_summary location
|> PO.ConditionSet.join cond_set |> PO.ConditionSet.join cond_set
| _ ->
cond_set )
| _ ->
cond_set
in
let mem' = Analyzer.TransferFunctions.exec_instr mem pdata node instr in
let () =
match (mem, mem') with
| NonBottom _, Bottom -> (
match instr with
| Sil.Prune (_, _, _, (Ik_land_lor | Ik_bexp)) ->
()
| Sil.Prune (cond, location, true_branch, _) ->
let i = match cond with Exp.Const Const.Cint i -> i | _ -> IntLit.zero in
let desc =
Errdesc.explain_condition_always_true_false tenv i cond node location
in
let exn =
Exceptions.Condition_always_true_false (desc, not true_branch, __POS__)
in
Reporting.log_warning summary ~loc:location exn
(* special case for `exit` when we're at the end of a block / procedure *)
| Sil.Call (_, Const Cfun pname, _, _, _)
when String.equal (Typ.Procname.get_method pname) "exit"
&& ExitStatement.is_end_of_block_or_procedure node rem_instrs ->
()
| _ -> | _ ->
let location = Sil.instr_get_loc instr in cond_set )
let desc = Errdesc.explain_unreachable_code_after location in | _ ->
let exn = Exceptions.Unreachable_code_after (desc, __POS__) in cond_set
Reporting.log_error summary ~loc:location exn ) in
| _ -> let mem' = Analyzer.TransferFunctions.exec_instr mem pdata node instr in
let () =
match (mem, mem') with
| NonBottom _, Bottom -> (
match instr with
| Sil.Prune (_, _, _, (Ik_land_lor | Ik_bexp)) ->
() ()
in | Sil.Prune (cond, location, true_branch, _) ->
print_debug_info instr mem' cond_set ; let i = match cond with Exp.Const Const.Cint i -> i | _ -> IntLit.zero in
collect_instrs summary pdata node rem_instrs mem' cond_set let desc = Errdesc.explain_condition_always_true_false tenv i cond node location in
let exn =
Exceptions.Condition_always_true_false (desc, not true_branch, __POS__)
in
Reporting.log_warning summary ~loc:location exn
(* special case for `exit` when we're at the end of a block / procedure *)
| Sil.Call (_, Const Cfun pname, _, _, _)
when String.equal (Typ.Procname.get_method pname) "exit"
&& ExitStatement.is_end_of_block_or_procedure node rem_instrs ->
()
| _ ->
let location = Sil.instr_get_loc instr in
let desc = Errdesc.explain_unreachable_code_after location in
let exn = Exceptions.Unreachable_code_after (desc, __POS__) in
Reporting.log_error summary ~loc:location exn )
| _ ->
()
in
print_debug_info instr mem' cond_set ;
collect_instrs summary pdata node rem_instrs mem' cond_set
let collect_node let collect_node
: Specs.summary -> extras ProcData.t -> Analyzer.invariant_map -> PO.ConditionSet.t : Specs.summary -> extras ProcData.t -> Analyzer.invariant_map -> PO.ConditionSet.t
-> CFG.node -> PO.ConditionSet.t = -> CFG.node -> PO.ConditionSet.t =
fun summary pdata inv_map cond_set node -> fun summary pdata inv_map cond_set node ->
match Analyzer.extract_pre (CFG.id node) inv_map with match Analyzer.extract_pre (CFG.id node) inv_map with
| Some mem -> | Some mem ->
let instrs = CFG.instrs node in let instrs = CFG.instrs node in
collect_instrs summary pdata node instrs mem cond_set collect_instrs summary pdata node instrs mem cond_set
| _ -> | _ ->
cond_set cond_set
let collect : Specs.summary -> extras ProcData.t -> Analyzer.invariant_map -> PO.ConditionSet.t = let collect : Specs.summary -> extras ProcData.t -> Analyzer.invariant_map -> PO.ConditionSet.t =
fun summary ({pdesc} as pdata) inv_map -> fun summary ({pdesc} as pdata) inv_map ->
let add_node1 acc node = collect_node summary pdata inv_map acc node in let add_node1 acc node = collect_node summary pdata inv_map acc node in
Procdesc.fold_nodes add_node1 PO.ConditionSet.empty pdesc Procdesc.fold_nodes add_node1 PO.ConditionSet.empty pdesc
let make_err_trace : Trace.t -> string -> Errlog.loc_trace = let make_err_trace : Trace.t -> string -> Errlog.loc_trace =
fun trace desc -> fun trace desc ->
let f elem (trace, depth) = let f elem (trace, depth) =
match elem with match elem with
| Trace.Assign location -> | Trace.Assign location ->
(Errlog.make_trace_element depth location "Assignment" [] :: trace, depth) (Errlog.make_trace_element depth location "Assignment" [] :: trace, depth)
| Trace.ArrDecl location -> | Trace.ArrDecl location ->
(Errlog.make_trace_element depth location "ArrayDeclaration" [] :: trace, depth) (Errlog.make_trace_element depth location "ArrayDeclaration" [] :: trace, depth)
| Trace.Call location -> | Trace.Call location ->
(Errlog.make_trace_element depth location "Call" [] :: trace, depth + 1) (Errlog.make_trace_element depth location "Call" [] :: trace, depth + 1)
| Trace.Return location -> | Trace.Return location ->
(Errlog.make_trace_element (depth - 1) location "Return" [] :: trace, depth - 1) (Errlog.make_trace_element (depth - 1) location "Return" [] :: trace, depth - 1)
| Trace.SymAssign _ -> | Trace.SymAssign _ ->
(trace, depth) (trace, depth)
| Trace.ArrAccess location -> | Trace.ArrAccess location ->
(Errlog.make_trace_element depth location ("ArrayAccess: " ^ desc) [] :: trace, depth) (Errlog.make_trace_element depth location ("ArrayAccess: " ^ desc) [] :: trace, depth)
in in
List.fold_right ~f ~init:([], 0) trace.trace |> fst |> List.rev List.fold_right ~f ~init:([], 0) trace.trace |> fst |> List.rev
let report_errors : Specs.summary -> Procdesc.t -> PO.ConditionSet.t -> unit = let report_errors : Specs.summary -> Procdesc.t -> PO.ConditionSet.t -> unit =
fun summary pdesc cond_set -> fun summary pdesc cond_set ->
let pname = Procdesc.get_proc_name pdesc in let pname = Procdesc.get_proc_name pdesc in
let report cond trace issue_type = let report cond trace issue_type =
let caller_pname, location = let caller_pname, location =
match PO.ConditionTrace.get_cond_trace trace with match PO.ConditionTrace.get_cond_trace trace with
| PO.ConditionTrace.Inter (caller_pname, _, location) -> | PO.ConditionTrace.Inter (caller_pname, _, location) ->
(caller_pname, location) (caller_pname, location)
| PO.ConditionTrace.Intra pname -> | PO.ConditionTrace.Intra pname ->
(pname, PO.ConditionTrace.get_location trace) (pname, PO.ConditionTrace.get_location trace)
in
if Typ.Procname.equal pname caller_pname then
let description = PO.description cond trace in
let error_desc = Localise.desc_buffer_overrun description in
let exn = Exceptions.Checkers (issue_type, error_desc) in
let trace =
match TraceSet.choose_shortest trace.PO.ConditionTrace.val_traces with
| trace ->
make_err_trace trace description
| exception _ ->
[Errlog.make_trace_element 0 location description []]
in
Reporting.log_error summary ~loc:location ~ltr:trace exn
in in
PO.ConditionSet.check_all ~report cond_set if Typ.Procname.equal pname caller_pname then
let description = PO.description cond trace in
let error_desc = Localise.desc_buffer_overrun description in
let exn = Exceptions.Checkers (issue_type, error_desc) in
let trace =
match TraceSet.choose_shortest trace.PO.ConditionTrace.val_traces with
| trace ->
make_err_trace trace description
| exception _ ->
[Errlog.make_trace_element 0 location description []]
in
Reporting.log_error summary ~loc:location ~ltr:trace exn
in
PO.ConditionSet.check_all ~report cond_set
end end
let compute_post let compute_post
: Specs.summary -> Analyzer.TransferFunctions.extras ProcData.t -> Summary.payload option = : Specs.summary -> Analyzer.TransferFunctions.extras ProcData.t -> Summary.payload option =
fun summary {pdesc; tenv; extras= get_pdesc} -> fun summary {pdesc; tenv; extras= get_pdesc} ->
let cfg = CFG.from_pdesc pdesc in let cfg = CFG.from_pdesc pdesc in
let pdata = ProcData.make pdesc tenv get_pdesc in let pdata = ProcData.make pdesc tenv get_pdesc in
let inv_map = Analyzer.exec_pdesc ~initial:Dom.Mem.init pdata in let inv_map = Analyzer.exec_pdesc ~initial:Dom.Mem.init pdata in
let entry_mem = let entry_mem =
let entry_id = CFG.id (CFG.start_node cfg) in let entry_id = CFG.id (CFG.start_node cfg) in
Analyzer.extract_post entry_id inv_map Analyzer.extract_post entry_id inv_map
in in
let exit_mem = let exit_mem =
let exit_id = CFG.id (CFG.exit_node cfg) in let exit_id = CFG.id (CFG.exit_node cfg) in
Analyzer.extract_post exit_id inv_map Analyzer.extract_post exit_id inv_map
in in
let cond_set = Report.collect summary pdata inv_map in let cond_set = Report.collect summary pdata inv_map in
Report.report_errors summary pdesc cond_set ; Report.report_errors summary pdesc cond_set ;
match (entry_mem, exit_mem) with match (entry_mem, exit_mem) with
| Some entry_mem, Some exit_mem -> | Some entry_mem, Some exit_mem ->
Some (entry_mem, exit_mem, cond_set) Some (entry_mem, exit_mem, cond_set)
| _ -> | _ ->
None None
let print_summary : Typ.Procname.t -> Dom.Summary.t -> unit = let print_summary : Typ.Procname.t -> Dom.Summary.t -> unit =
fun proc_name s -> fun proc_name s ->
L.(debug BufferOverrun Medium) L.(debug BufferOverrun Medium)
"@\n@[<v 2>Summary of %a :@,%a@]@." Typ.Procname.pp proc_name Dom.Summary.pp_summary s "@\n@[<v 2>Summary of %a :@,%a@]@." Typ.Procname.pp proc_name Dom.Summary.pp_summary s
let checker : Callbacks.proc_callback_args -> Specs.summary = let checker : Callbacks.proc_callback_args -> Specs.summary =
fun {proc_desc; tenv; summary; get_proc_desc} -> fun {proc_desc; tenv; summary; get_proc_desc} ->
let proc_data = ProcData.make proc_desc tenv get_proc_desc in let proc_data = ProcData.make proc_desc tenv get_proc_desc in
Preanal.do_preanalysis proc_desc tenv ; Preanal.do_preanalysis proc_desc tenv ;
match compute_post summary proc_data with match compute_post summary proc_data with
| Some post -> | Some post ->
( if Config.bo_debug >= 1 then ( if Config.bo_debug >= 1 then
let proc_name = Specs.get_proc_name summary in let proc_name = Specs.get_proc_name summary in
print_summary proc_name post ) ; print_summary proc_name post ) ;
Summary.update_summary post summary Summary.update_summary post summary
| None -> | None ->
summary summary

@ -61,13 +61,13 @@ module Val = struct
let join : t -> t -> t = let join : t -> t -> t =
fun x y -> fun x y ->
if phys_equal x y then x if phys_equal x y then x
else else
{ itv= Itv.join x.itv y.itv { itv= Itv.join x.itv y.itv
; powloc= PowLoc.join x.powloc y.powloc ; powloc= PowLoc.join x.powloc y.powloc
; arrayblk= ArrayBlk.join x.arrayblk y.arrayblk ; arrayblk= ArrayBlk.join x.arrayblk y.arrayblk
; traces= TraceSet.join x.traces y.traces } ; traces= TraceSet.join x.traces y.traces }
let rec joins : t list -> t = function [] -> bot | [a] -> a | a :: b -> join a (joins b) let rec joins : t list -> t = function [] -> bot | [a] -> a | a :: b -> join a (joins b)
@ -97,8 +97,8 @@ module Val = struct
let modify_itv : Itv.t -> t -> t = fun i x -> {x with itv= i} let modify_itv : Itv.t -> t -> t = fun i x -> {x with itv= i}
let make_sym : ?unsigned:bool -> Typ.Procname.t -> (unit -> int) -> t = let make_sym : ?unsigned:bool -> Typ.Procname.t -> (unit -> int) -> t =
fun ?(unsigned= false) pname new_sym_num -> fun ?(unsigned= false) pname new_sym_num ->
{bot with itv= Itv.make_sym ~unsigned pname new_sym_num} {bot with itv= Itv.make_sym ~unsigned pname new_sym_num}
let unknown_bit : t -> t = fun x -> {x with itv= Itv.top} let unknown_bit : t -> t = fun x -> {x with itv= Itv.top}
@ -108,37 +108,37 @@ module Val = struct
let lnot : t -> t = fun x -> {x with itv= Itv.lnot x.itv} let lnot : t -> t = fun x -> {x with itv= Itv.lnot x.itv}
let lift_itv : (Itv.t -> Itv.t -> Itv.t) -> t -> t -> t = let lift_itv : (Itv.t -> Itv.t -> Itv.t) -> t -> t -> t =
fun f x y -> {bot with itv= f x.itv y.itv} fun f x y -> {bot with itv= f x.itv y.itv}
let has_pointer : t -> bool = fun x -> not (PowLoc.is_bot x.powloc && ArrayBlk.is_bot x.arrayblk) let has_pointer : t -> bool = fun x -> not (PowLoc.is_bot x.powloc && ArrayBlk.is_bot x.arrayblk)
let lift_cmp_itv : (Itv.t -> Itv.t -> Itv.t) -> t -> t -> t = let lift_cmp_itv : (Itv.t -> Itv.t -> Itv.t) -> t -> t -> t =
fun f x y -> fun f x y ->
if has_pointer x || has_pointer y then {bot with itv= Itv.unknown_bool} else lift_itv f x y if has_pointer x || has_pointer y then {bot with itv= Itv.unknown_bool} else lift_itv f x y
let plus : t -> t -> t = let plus : t -> t -> t =
fun x y -> fun x y ->
{ x with { x with
itv= Itv.plus x.itv y.itv itv= Itv.plus x.itv y.itv
; arrayblk= ArrayBlk.plus_offset x.arrayblk y.itv ; arrayblk= ArrayBlk.plus_offset x.arrayblk y.itv
; traces= TraceSet.join x.traces y.traces } ; traces= TraceSet.join x.traces y.traces }
let minus : t -> t -> t = let minus : t -> t -> t =
fun x y -> fun x y ->
let n = Itv.join (Itv.minus x.itv y.itv) (ArrayBlk.diff x.arrayblk y.arrayblk) in let n = Itv.join (Itv.minus x.itv y.itv) (ArrayBlk.diff x.arrayblk y.arrayblk) in
let a = ArrayBlk.minus_offset x.arrayblk y.itv in let a = ArrayBlk.minus_offset x.arrayblk y.itv in
{bot with itv= n; arrayblk= a; traces= TraceSet.join x.traces y.traces} {bot with itv= n; arrayblk= a; traces= TraceSet.join x.traces y.traces}
let mult : t -> t -> t = let mult : t -> t -> t =
fun x y -> {(lift_itv Itv.mult x y) with traces= TraceSet.join x.traces y.traces} fun x y -> {(lift_itv Itv.mult x y) with traces= TraceSet.join x.traces y.traces}
let div : t -> t -> t = let div : t -> t -> t =
fun x y -> {(lift_itv Itv.div x y) with traces= TraceSet.join x.traces y.traces} fun x y -> {(lift_itv Itv.div x y) with traces= TraceSet.join x.traces y.traces}
let mod_sem : t -> t -> t = lift_itv Itv.mod_sem let mod_sem : t -> t -> t = lift_itv Itv.mod_sem
@ -168,17 +168,17 @@ module Val = struct
let lift_prune2 let lift_prune2
: (Itv.t -> Itv.t -> Itv.t) -> (ArrayBlk.astate -> ArrayBlk.astate -> ArrayBlk.astate) -> t : (Itv.t -> Itv.t -> Itv.t) -> (ArrayBlk.astate -> ArrayBlk.astate -> ArrayBlk.astate) -> t
-> t -> t = -> t -> t =
fun f g x y -> fun f g x y ->
{ x with { x with
itv= f x.itv y.itv itv= f x.itv y.itv
; arrayblk= g x.arrayblk y.arrayblk ; arrayblk= g x.arrayblk y.arrayblk
; traces= TraceSet.join x.traces y.traces } ; traces= TraceSet.join x.traces y.traces }
let prune_zero : t -> t = lift_prune1 Itv.prune_zero let prune_zero : t -> t = lift_prune1 Itv.prune_zero
let prune_comp : Binop.t -> t -> t -> t = let prune_comp : Binop.t -> t -> t -> t =
fun c -> lift_prune2 (Itv.prune_comp c) (ArrayBlk.prune_comp c) fun c -> lift_prune2 (Itv.prune_comp c) (ArrayBlk.prune_comp c)
let prune_eq : t -> t -> t = lift_prune2 Itv.prune_eq ArrayBlk.prune_eq let prune_eq : t -> t -> t = lift_prune2 Itv.prune_eq ArrayBlk.prune_eq
@ -186,7 +186,7 @@ module Val = struct
let prune_ne : t -> t -> t = lift_prune2 Itv.prune_ne ArrayBlk.prune_eq let prune_ne : t -> t -> t = lift_prune2 Itv.prune_ne ArrayBlk.prune_eq
let lift_pi : (ArrayBlk.astate -> Itv.t -> ArrayBlk.astate) -> t -> t -> t = let lift_pi : (ArrayBlk.astate -> Itv.t -> ArrayBlk.astate) -> t -> t -> t =
fun f x y -> {bot with arrayblk= f x.arrayblk y.itv; traces= TraceSet.join x.traces y.traces} fun f x y -> {bot with arrayblk= f x.arrayblk y.itv; traces= TraceSet.join x.traces y.traces}
let plus_pi : t -> t -> t = fun x y -> lift_pi ArrayBlk.plus_offset x y let plus_pi : t -> t -> t = fun x y -> lift_pi ArrayBlk.plus_offset x y
@ -194,54 +194,53 @@ module Val = struct
let minus_pi : t -> t -> t = fun x y -> lift_pi ArrayBlk.minus_offset x y let minus_pi : t -> t -> t = fun x y -> lift_pi ArrayBlk.minus_offset x y
let minus_pp : t -> t -> t = let minus_pp : t -> t -> t =
fun x y -> fun x y ->
(* when we cannot precisely follow the physical memory model, return top *) (* when we cannot precisely follow the physical memory model, return top *)
if not (PowLoc.is_bot x.powloc) && ArrayBlk.is_bot x.arrayblk if not (PowLoc.is_bot x.powloc) && ArrayBlk.is_bot x.arrayblk
|| not (PowLoc.is_bot y.powloc) && ArrayBlk.is_bot y.arrayblk || not (PowLoc.is_bot y.powloc) && ArrayBlk.is_bot y.arrayblk
then {bot with itv= Itv.top} then {bot with itv= Itv.top}
else else
{bot with itv= ArrayBlk.diff x.arrayblk y.arrayblk; traces= TraceSet.join x.traces y.traces} {bot with itv= ArrayBlk.diff x.arrayblk y.arrayblk; traces= TraceSet.join x.traces y.traces}
let get_symbols : t -> Itv.Symbol.t list = let get_symbols : t -> Itv.Symbol.t list =
fun x -> List.append (Itv.get_symbols x.itv) (ArrayBlk.get_symbols x.arrayblk) fun x -> List.append (Itv.get_symbols x.itv) (ArrayBlk.get_symbols x.arrayblk)
let normalize : t -> t = let normalize : t -> t =
fun x -> {x with itv= Itv.normalize x.itv; arrayblk= ArrayBlk.normalize x.arrayblk} fun x -> {x with itv= Itv.normalize x.itv; arrayblk= ArrayBlk.normalize x.arrayblk}
let subst let subst
: t -> Itv.Bound.t bottom_lifted Itv.SubstMap.t * TraceSet.t Itv.SubstMap.t -> Location.t : t -> Itv.Bound.t bottom_lifted Itv.SubstMap.t * TraceSet.t Itv.SubstMap.t -> Location.t
-> t = -> t =
fun x (bound_map, trace_map) location -> fun x (bound_map, trace_map) location ->
let symbols = get_symbols x in let symbols = get_symbols x in
let traces_caller = let traces_caller =
List.fold symbols List.fold symbols
~f:(fun traces symbol -> ~f:(fun traces symbol ->
try TraceSet.join (Itv.SubstMap.find symbol trace_map) traces with Not_found -> traces try TraceSet.join (Itv.SubstMap.find symbol trace_map) traces with Not_found -> traces )
) ~init:TraceSet.empty
~init:TraceSet.empty in
in let traces = TraceSet.instantiate ~traces_caller ~traces_callee:x.traces location in
let traces = TraceSet.instantiate ~traces_caller ~traces_callee:x.traces location in {x with itv= Itv.subst x.itv bound_map; arrayblk= ArrayBlk.subst x.arrayblk bound_map; traces}
{x with itv= Itv.subst x.itv bound_map; arrayblk= ArrayBlk.subst x.arrayblk bound_map; traces} |> normalize
|> normalize
(* normalize bottom *) (* normalize bottom *)
let add_trace_elem : Trace.elem -> t -> t = let add_trace_elem : Trace.elem -> t -> t =
fun elem x -> fun elem x ->
let traces = TraceSet.add_elem elem x.traces in let traces = TraceSet.add_elem elem x.traces in
{x with traces} {x with traces}
let pp_summary : F.formatter -> t -> unit = let pp_summary : F.formatter -> t -> unit =
fun fmt x -> F.fprintf fmt "(%a, %a)" Itv.pp x.itv ArrayBlk.pp x.arrayblk fun fmt x -> F.fprintf fmt "(%a, %a)" Itv.pp x.itv ArrayBlk.pp x.arrayblk
let set_array_size : Itv.t -> t -> t = let set_array_size : Itv.t -> t -> t =
fun size v -> {v with arrayblk= ArrayBlk.set_size size v.arrayblk} fun size v -> {v with arrayblk= ArrayBlk.set_size size v.arrayblk}
module Itv = struct module Itv = struct
@ -261,18 +260,18 @@ module Stack = struct
let find : Loc.t -> astate -> Val.t = fun l m -> try find l m with Not_found -> Val.bot let find : Loc.t -> astate -> Val.t = fun l m -> try find l m with Not_found -> Val.bot
let find_set : PowLoc.t -> astate -> Val.t = let find_set : PowLoc.t -> astate -> Val.t =
fun locs mem -> fun locs mem ->
let find_join loc acc = Val.join acc (find loc mem) in let find_join loc acc = Val.join acc (find loc mem) in
PowLoc.fold find_join locs Val.bot PowLoc.fold find_join locs Val.bot
let remove_temps : Ident.t list -> astate -> astate = let remove_temps : Ident.t list -> astate -> astate =
fun temps mem -> fun temps mem ->
let remove_temp mem temp = let remove_temp mem temp =
let temp_loc = Loc.of_id temp in let temp_loc = Loc.of_id temp in
remove temp_loc mem remove temp_loc mem
in in
List.fold temps ~init:mem ~f:remove_temp List.fold temps ~init:mem ~f:remove_temp
end end
module Heap = struct module Heap = struct
@ -287,35 +286,35 @@ module Heap = struct
let find : Loc.t -> astate -> Val.t = fun l m -> try find l m with Not_found -> Val.Itv.top let find : Loc.t -> astate -> Val.t = fun l m -> try find l m with Not_found -> Val.Itv.top
let find_set : PowLoc.t -> astate -> Val.t = let find_set : PowLoc.t -> astate -> Val.t =
fun locs mem -> fun locs mem ->
let find_join loc acc = Val.join acc (find loc mem) in let find_join loc acc = Val.join acc (find loc mem) in
PowLoc.fold find_join locs Val.bot PowLoc.fold find_join locs Val.bot
let transform : f:(Val.t -> Val.t) -> PowLoc.t -> astate -> astate = let transform : f:(Val.t -> Val.t) -> PowLoc.t -> astate -> astate =
fun ~f locs mem -> PowLoc.fold (fun loc -> find loc mem |> f |> add loc) locs mem fun ~f locs mem -> PowLoc.fold (fun loc -> find loc mem |> f |> add loc) locs mem
let strong_update : PowLoc.t -> Val.t -> astate -> astate = let strong_update : PowLoc.t -> Val.t -> astate -> astate =
fun locs v mem -> PowLoc.fold (fun x -> add x v) locs mem fun locs v mem -> PowLoc.fold (fun x -> add x v) locs mem
let weak_update : PowLoc.t -> Val.t -> astate -> astate = let weak_update : PowLoc.t -> Val.t -> astate -> astate =
fun locs v mem -> PowLoc.fold (fun x -> add x (Val.join v (find x mem))) locs mem fun locs v mem -> PowLoc.fold (fun x -> add x (Val.join v (find x mem))) locs mem
let pp_summary : F.formatter -> astate -> unit = let pp_summary : F.formatter -> astate -> unit =
fun fmt mem -> fun fmt mem ->
let pp_map fmt (k, v) = F.fprintf fmt "%a -> %a" Loc.pp k Val.pp_summary v in let pp_map fmt (k, v) = F.fprintf fmt "%a -> %a" Loc.pp k Val.pp_summary v in
F.fprintf fmt "@[<v 2>{ " ; F.fprintf fmt "@[<v 2>{ " ;
F.pp_print_list pp_map fmt (bindings mem) ; F.pp_print_list pp_map fmt (bindings mem) ;
F.fprintf fmt " }@]" F.fprintf fmt " }@]"
let get_return : astate -> Val.t = let get_return : astate -> Val.t =
fun mem -> fun mem ->
let mem = filter (fun l _ -> Loc.is_return l) mem in let mem = filter (fun l _ -> Loc.is_return l) mem in
if is_empty mem then Val.bot else snd (choose mem) if is_empty mem then Val.bot else snd (choose mem)
end end
module AliasTarget = struct module AliasTarget = struct
@ -356,56 +355,56 @@ module AliasMap = struct
let bot : t = M.empty let bot : t = M.empty
let ( <= ) : lhs:t -> rhs:t -> bool = let ( <= ) : lhs:t -> rhs:t -> bool =
fun ~lhs ~rhs -> fun ~lhs ~rhs ->
let is_in_rhs k v = let is_in_rhs k v =
match M.find k rhs with v' -> AliasTarget.equal v v' | exception Not_found -> false match M.find k rhs with v' -> AliasTarget.equal v v' | exception Not_found -> false
in in
M.for_all is_in_rhs lhs M.for_all is_in_rhs lhs
let join : t -> t -> t = let join : t -> t -> t =
fun x y -> fun x y ->
let join_v _ v1_opt v2_opt = let join_v _ v1_opt v2_opt =
match (v1_opt, v2_opt) with match (v1_opt, v2_opt) with
| None, None -> | None, None ->
None None
| Some v, None | None, Some v -> | Some v, None | None, Some v ->
Some v Some v
| Some v1, Some v2 -> | Some v1, Some v2 ->
if AliasTarget.equal v1 v2 then Some v1 else assert false if AliasTarget.equal v1 v2 then Some v1 else assert false
in in
M.merge join_v x y M.merge join_v x y
let widen : prev:t -> next:t -> num_iters:int -> t = let widen : prev:t -> next:t -> num_iters:int -> t =
fun ~prev ~next ~num_iters:_ -> join prev next fun ~prev ~next ~num_iters:_ -> join prev next
let pp : F.formatter -> t -> unit = let pp : F.formatter -> t -> unit =
fun fmt x -> fun fmt x ->
let pp_sep fmt () = F.fprintf fmt ", @," in let pp_sep fmt () = F.fprintf fmt ", @," in
let pp1 fmt (k, v) = F.fprintf fmt "%a=%a" Ident.pp k AliasTarget.pp v in let pp1 fmt (k, v) = F.fprintf fmt "%a=%a" Ident.pp k AliasTarget.pp v in
(* F.fprintf fmt "@[<v 0>Logical Variables :@,"; *) (* F.fprintf fmt "@[<v 0>Logical Variables :@,"; *)
F.fprintf fmt "@[<hov 2>{ @," ; F.fprintf fmt "@[<hov 2>{ @," ;
F.pp_print_list ~pp_sep pp1 fmt (M.bindings x) ; F.pp_print_list ~pp_sep pp1 fmt (M.bindings x) ;
F.fprintf fmt " }@]" ; F.fprintf fmt " }@]" ;
F.fprintf fmt "@]" F.fprintf fmt "@]"
let load : Ident.t -> AliasTarget.t -> t -> t = fun id loc m -> M.add id loc m let load : Ident.t -> AliasTarget.t -> t -> t = fun id loc m -> M.add id loc m
let store : Loc.t -> Exp.t -> t -> t = let store : Loc.t -> Exp.t -> t -> t =
fun l _ m -> M.filter (fun _ y -> not (AliasTarget.use l y)) m fun l _ m -> M.filter (fun _ y -> not (AliasTarget.use l y)) m
let find : Ident.t -> t -> AliasTarget.t option = let find : Ident.t -> t -> AliasTarget.t option =
fun k m -> try Some (M.find k m) with Not_found -> None fun k m -> try Some (M.find k m) with Not_found -> None
let remove_temps : Ident.t list -> t -> t = let remove_temps : Ident.t list -> t -> t =
fun temps m -> fun temps m ->
let remove_temp m temp = M.remove temp m in let remove_temp m temp = M.remove temp m in
List.fold temps ~init:m ~f:remove_temp List.fold temps ~init:m ~f:remove_temp
end end
module AliasRet = struct module AliasRet = struct
@ -414,40 +413,40 @@ module AliasRet = struct
let bot = Bot let bot = Bot
let ( <= ) : lhs:astate -> rhs:astate -> bool = let ( <= ) : lhs:astate -> rhs:astate -> bool =
fun ~lhs ~rhs -> fun ~lhs ~rhs ->
match (lhs, rhs) with match (lhs, rhs) with
| Bot, _ | _, Top -> | Bot, _ | _, Top ->
true true
| Top, _ | _, Bot -> | Top, _ | _, Bot ->
false false
| L loc1, L loc2 -> | L loc1, L loc2 ->
AliasTarget.equal loc1 loc2 AliasTarget.equal loc1 loc2
let join : astate -> astate -> astate = let join : astate -> astate -> astate =
fun x y -> fun x y ->
match (x, y) with match (x, y) with
| Top, _ | _, Top -> | Top, _ | _, Top ->
Top Top
| Bot, a | a, Bot -> | Bot, a | a, Bot ->
a a
| L loc1, L loc2 -> | L loc1, L loc2 ->
if AliasTarget.equal loc1 loc2 then x else Top if AliasTarget.equal loc1 loc2 then x else Top
let widen : prev:astate -> next:astate -> num_iters:int -> astate = let widen : prev:astate -> next:astate -> num_iters:int -> astate =
fun ~prev ~next ~num_iters:_ -> join prev next fun ~prev ~next ~num_iters:_ -> join prev next
let pp : F.formatter -> astate -> unit = let pp : F.formatter -> astate -> unit =
fun fmt x -> fun fmt x ->
match x with match x with
| Top -> | Top ->
F.fprintf fmt "T" F.fprintf fmt "T"
| L loc -> | L loc ->
AliasTarget.pp fmt loc AliasTarget.pp fmt loc
| Bot -> | Bot ->
F.fprintf fmt "_|_" F.fprintf fmt "_|_"
let find : astate -> AliasTarget.t option = fun x -> match x with L loc -> Some loc | _ -> None let find : astate -> AliasTarget.t option = fun x -> match x with L loc -> Some loc | _ -> None
@ -459,7 +458,7 @@ module Alias = struct
let bot : astate = (AliasMap.bot, AliasRet.bot) let bot : astate = (AliasMap.bot, AliasRet.bot)
let lift : (AliasMap.astate -> AliasMap.astate) -> astate -> astate = let lift : (AliasMap.astate -> AliasMap.astate) -> astate -> astate =
fun f a -> (f (fst a), snd a) fun f a -> (f (fst a), snd a)
let lift_v : (AliasMap.astate -> 'a) -> astate -> 'a = fun f a -> f (fst a) let lift_v : (AliasMap.astate -> 'a) -> astate -> 'a = fun f a -> f (fst a)
@ -469,31 +468,31 @@ module Alias = struct
let find_ret : astate -> AliasTarget.t option = fun x -> AliasRet.find (snd x) let find_ret : astate -> AliasTarget.t option = fun x -> AliasRet.find (snd x)
let load : Ident.t -> AliasTarget.t -> astate -> astate = let load : Ident.t -> AliasTarget.t -> astate -> astate =
fun id loc -> lift (AliasMap.load id loc) fun id loc -> lift (AliasMap.load id loc)
let store_simple : Loc.t -> Exp.t -> astate -> astate = let store_simple : Loc.t -> Exp.t -> astate -> astate =
fun loc e a -> fun loc e a ->
let a = lift (AliasMap.store loc e) a in let a = lift (AliasMap.store loc e) a in
match e with match e with
| Exp.Var l when Loc.is_return loc -> | Exp.Var l when Loc.is_return loc ->
let update_ret retl = (fst a, AliasRet.L retl) in let update_ret retl = (fst a, AliasRet.L retl) in
Option.value_map (find l a) ~default:a ~f:update_ret Option.value_map (find l a) ~default:a ~f:update_ret
| _ -> | _ ->
a a
let store_empty : Val.t -> Loc.t -> Exp.t -> astate -> astate = let store_empty : Val.t -> Loc.t -> Exp.t -> astate -> astate =
fun formal loc e a -> fun formal loc e a ->
let a = lift (AliasMap.store loc e) a in let a = lift (AliasMap.store loc e) a in
let locs = Val.get_all_locs formal in let locs = Val.get_all_locs formal in
if PowLoc.is_singleton locs then if PowLoc.is_singleton locs then
(fst a, AliasRet.L (AliasTarget.of_empty (PowLoc.min_elt locs))) (fst a, AliasRet.L (AliasTarget.of_empty (PowLoc.min_elt locs)))
else a else a
let remove_temps : Ident.t list -> astate -> astate = let remove_temps : Ident.t list -> astate -> astate =
fun temps a -> (AliasMap.remove_temps temps (fst a), snd a) fun temps a -> (AliasMap.remove_temps temps (fst a), snd a)
end end
module PrunePairs = struct module PrunePairs = struct
@ -605,26 +604,26 @@ module MemReach = struct
let join : t -> t -> t = let join : t -> t -> t =
fun x y -> fun x y ->
{ stack= Stack.join x.stack y.stack { stack= Stack.join x.stack y.stack
; heap= Heap.join x.heap y.heap ; heap= Heap.join x.heap y.heap
; alias= Alias.join x.alias y.alias ; alias= Alias.join x.alias y.alias
; latest_prune= LatestPrune.join x.latest_prune y.latest_prune } ; latest_prune= LatestPrune.join x.latest_prune y.latest_prune }
let pp : F.formatter -> t -> unit = let pp : F.formatter -> t -> unit =
fun fmt x -> fun fmt x ->
F.fprintf fmt "Stack:@;" ; F.fprintf fmt "Stack:@;" ;
F.fprintf fmt "%a@;" Stack.pp x.stack ; F.fprintf fmt "%a@;" Stack.pp x.stack ;
F.fprintf fmt "Heap:@;" ; F.fprintf fmt "Heap:@;" ;
F.fprintf fmt "%a" Heap.pp x.heap F.fprintf fmt "%a" Heap.pp x.heap
let pp_summary : F.formatter -> t -> unit = let pp_summary : F.formatter -> t -> unit =
fun fmt x -> fun fmt x ->
F.fprintf fmt "@[<v 0>Parameters:@," ; F.fprintf fmt "@[<v 0>Parameters:@," ;
F.fprintf fmt "%a" Heap.pp_summary x.heap ; F.fprintf fmt "%a" Heap.pp_summary x.heap ;
F.fprintf fmt "@]" F.fprintf fmt "@]"
let find_stack : Loc.t -> t -> Val.t = fun k m -> Stack.find k m.stack let find_stack : Loc.t -> t -> Val.t = fun k m -> Stack.find k m.stack
@ -636,32 +635,32 @@ module MemReach = struct
let find_heap_set : PowLoc.t -> t -> Val.t = fun k m -> Heap.find_set k m.heap let find_heap_set : PowLoc.t -> t -> Val.t = fun k m -> Heap.find_set k m.heap
let find_set : PowLoc.t -> t -> Val.t = let find_set : PowLoc.t -> t -> Val.t =
fun k m -> Val.join (find_stack_set k m) (find_heap_set k m) fun k m -> Val.join (find_stack_set k m) (find_heap_set k m)
let find_alias : Ident.t -> t -> AliasTarget.t option = fun k m -> Alias.find k m.alias let find_alias : Ident.t -> t -> AliasTarget.t option = fun k m -> Alias.find k m.alias
let find_simple_alias : Ident.t -> t -> Loc.t option = let find_simple_alias : Ident.t -> t -> Loc.t option =
fun k m -> fun k m ->
match Alias.find k m.alias with match Alias.find k m.alias with
| Some AliasTarget.Simple l -> | Some AliasTarget.Simple l ->
Some l Some l
| Some AliasTarget.Empty _ | None -> | Some AliasTarget.Empty _ | None ->
None None
let find_ret_alias : t -> AliasTarget.t option = fun m -> Alias.find_ret m.alias let find_ret_alias : t -> AliasTarget.t option = fun m -> Alias.find_ret m.alias
let load_alias : Ident.t -> AliasTarget.t -> t -> t = let load_alias : Ident.t -> AliasTarget.t -> t -> t =
fun id loc m -> {m with alias= Alias.load id loc m.alias} fun id loc m -> {m with alias= Alias.load id loc m.alias}
let store_simple_alias : Loc.t -> Exp.t -> t -> t = let store_simple_alias : Loc.t -> Exp.t -> t -> t =
fun loc e m -> {m with alias= Alias.store_simple loc e m.alias} fun loc e m -> {m with alias= Alias.store_simple loc e m.alias}
let store_empty_alias : Val.t -> Loc.t -> Exp.t -> t -> t = let store_empty_alias : Val.t -> Loc.t -> Exp.t -> t -> t =
fun formal loc e m -> {m with alias= Alias.store_empty formal loc e m.alias} fun formal loc e m -> {m with alias= Alias.store_empty formal loc e m.alias}
let add_stack : Loc.t -> Val.t -> t -> t = fun k v m -> {m with stack= Stack.add k v m.stack} let add_stack : Loc.t -> Val.t -> t -> t = fun k v m -> {m with stack= Stack.add k v m.stack}
@ -669,73 +668,72 @@ module MemReach = struct
let add_heap : Loc.t -> Val.t -> t -> t = fun k v m -> {m with heap= Heap.add k v m.heap} let add_heap : Loc.t -> Val.t -> t -> t = fun k v m -> {m with heap= Heap.add k v m.heap}
let strong_update_heap : PowLoc.t -> Val.t -> t -> t = let strong_update_heap : PowLoc.t -> Val.t -> t -> t =
fun p v m -> {m with heap= Heap.strong_update p v m.heap} fun p v m -> {m with heap= Heap.strong_update p v m.heap}
let transform_heap : f:(Val.t -> Val.t) -> PowLoc.t -> t -> t = let transform_heap : f:(Val.t -> Val.t) -> PowLoc.t -> t -> t =
fun ~f p m -> {m with heap= Heap.transform ~f p m.heap} fun ~f p m -> {m with heap= Heap.transform ~f p m.heap}
let weak_update_heap : PowLoc.t -> Val.t -> t -> t = let weak_update_heap : PowLoc.t -> Val.t -> t -> t =
fun p v m -> {m with heap= Heap.weak_update p v m.heap} fun p v m -> {m with heap= Heap.weak_update p v m.heap}
let get_return : t -> Val.t = fun m -> Heap.get_return m.heap let get_return : t -> Val.t = fun m -> Heap.get_return m.heap
let can_strong_update : PowLoc.t -> bool = let can_strong_update : PowLoc.t -> bool =
fun ploc -> fun ploc ->
if always_strong_update then true if always_strong_update then true
else if Int.equal (PowLoc.cardinal ploc) 1 then Loc.is_var (PowLoc.choose ploc) else if Int.equal (PowLoc.cardinal ploc) 1 then Loc.is_var (PowLoc.choose ploc)
else false else false
let update_mem : PowLoc.t -> Val.t -> t -> t = let update_mem : PowLoc.t -> Val.t -> t -> t =
fun ploc v s -> fun ploc v s ->
if can_strong_update ploc then strong_update_heap ploc v s if can_strong_update ploc then strong_update_heap ploc v s
else else
let () = let () =
L.(debug BufferOverrun Verbose) "Weak update for %a <- %a@." PowLoc.pp ploc Val.pp v L.(debug BufferOverrun Verbose) "Weak update for %a <- %a@." PowLoc.pp ploc Val.pp v
in in
weak_update_heap ploc v s weak_update_heap ploc v s
let transform_mem : f:(Val.t -> Val.t) -> PowLoc.t -> t -> t = let transform_mem : f:(Val.t -> Val.t) -> PowLoc.t -> t -> t =
fun ~f ploc s -> transform_heap ~f ploc s fun ~f ploc s -> transform_heap ~f ploc s
let remove_temps : Ident.t list -> t -> t = let remove_temps : Ident.t list -> t -> t =
fun temps m -> fun temps m ->
{m with stack= Stack.remove_temps temps m.stack; alias= Alias.remove_temps temps m.alias} {m with stack= Stack.remove_temps temps m.stack; alias= Alias.remove_temps temps m.alias}
let set_prune_pairs : PrunePairs.t -> t -> t = let set_prune_pairs : PrunePairs.t -> t -> t =
fun prune_pairs m -> {m with latest_prune= LatestPrune.Latest prune_pairs} fun prune_pairs m -> {m with latest_prune= LatestPrune.Latest prune_pairs}
let apply_latest_prune : Exp.t -> t -> t = let apply_latest_prune : Exp.t -> t -> t =
fun e m -> fun e m ->
match (m.latest_prune, e) with match (m.latest_prune, e) with
| LatestPrune.V (x, prunes, _), Exp.Var r | LatestPrune.V (x, prunes, _), Exp.Var r
| LatestPrune.V (x, _, prunes), Exp.UnOp (Unop.LNot, Exp.Var r, _) -> ( | LatestPrune.V (x, _, prunes), Exp.UnOp (Unop.LNot, Exp.Var r, _) -> (
match find_simple_alias r m with match find_simple_alias r m with
| Some Loc.Var Var.ProgramVar y when Pvar.equal x y -> | Some Loc.Var Var.ProgramVar y when Pvar.equal x y ->
List.fold_left prunes ~init:m ~f:(fun acc (l, v) -> List.fold_left prunes ~init:m ~f:(fun acc (l, v) -> update_mem (PowLoc.singleton l) v acc)
update_mem (PowLoc.singleton l) v acc )
| _ ->
m )
| _ -> | _ ->
m m )
| _ ->
m
let update_latest_prune : Exp.t -> Exp.t -> t -> t = let update_latest_prune : Exp.t -> Exp.t -> t -> t =
fun e1 e2 m -> fun e1 e2 m ->
match (e1, e2, m.latest_prune) with match (e1, e2, m.latest_prune) with
| Lvar x, Const Const.Cint i, LatestPrune.Latest p -> | Lvar x, Const Const.Cint i, LatestPrune.Latest p ->
if IntLit.isone i then {m with latest_prune= LatestPrune.TrueBranch (x, p)} if IntLit.isone i then {m with latest_prune= LatestPrune.TrueBranch (x, p)}
else if IntLit.iszero i then {m with latest_prune= LatestPrune.FalseBranch (x, p)} else if IntLit.iszero i then {m with latest_prune= LatestPrune.FalseBranch (x, p)}
else {m with latest_prune= LatestPrune.Top} else {m with latest_prune= LatestPrune.Top}
| _, _, _ -> | _, _, _ ->
{m with latest_prune= LatestPrune.Top} {m with latest_prune= LatestPrune.Top}
end end
module Mem = struct module Mem = struct
@ -748,60 +746,60 @@ module Mem = struct
let init : t = NonBottom MemReach.init let init : t = NonBottom MemReach.init
let f_lift_default : 'a -> (MemReach.t -> 'a) -> t -> 'a = let f_lift_default : 'a -> (MemReach.t -> 'a) -> t -> 'a =
fun default f m -> match m with Bottom -> default | NonBottom m' -> f m' fun default f m -> match m with Bottom -> default | NonBottom m' -> f m'
let f_lift : (MemReach.t -> MemReach.t) -> t -> t = let f_lift : (MemReach.t -> MemReach.t) -> t -> t =
fun f -> f_lift_default Bottom (fun m' -> NonBottom (f m')) fun f -> f_lift_default Bottom (fun m' -> NonBottom (f m'))
let pp_summary : F.formatter -> t -> unit = let pp_summary : F.formatter -> t -> unit =
fun fmt m -> fun fmt m ->
match m with match m with
| Bottom -> | Bottom ->
F.fprintf fmt "unreachable" F.fprintf fmt "unreachable"
| NonBottom m' -> | NonBottom m' ->
MemReach.pp_summary fmt m' MemReach.pp_summary fmt m'
let find_stack : Loc.t -> t -> Val.t = fun k -> f_lift_default Val.bot (MemReach.find_stack k) let find_stack : Loc.t -> t -> Val.t = fun k -> f_lift_default Val.bot (MemReach.find_stack k)
let find_stack_set : PowLoc.t -> t -> Val.t = let find_stack_set : PowLoc.t -> t -> Val.t =
fun k -> f_lift_default Val.bot (MemReach.find_stack_set k) fun k -> f_lift_default Val.bot (MemReach.find_stack_set k)
let find_heap : Loc.t -> t -> Val.t = fun k -> f_lift_default Val.bot (MemReach.find_heap k) let find_heap : Loc.t -> t -> Val.t = fun k -> f_lift_default Val.bot (MemReach.find_heap k)
let find_heap_set : PowLoc.t -> t -> Val.t = let find_heap_set : PowLoc.t -> t -> Val.t =
fun k -> f_lift_default Val.bot (MemReach.find_heap_set k) fun k -> f_lift_default Val.bot (MemReach.find_heap_set k)
let find_set : PowLoc.t -> t -> Val.t = fun k -> f_lift_default Val.bot (MemReach.find_set k) let find_set : PowLoc.t -> t -> Val.t = fun k -> f_lift_default Val.bot (MemReach.find_set k)
let find_alias : Ident.t -> t -> AliasTarget.t option = let find_alias : Ident.t -> t -> AliasTarget.t option =
fun k -> f_lift_default None (MemReach.find_alias k) fun k -> f_lift_default None (MemReach.find_alias k)
let find_simple_alias : Ident.t -> t -> Loc.t option = let find_simple_alias : Ident.t -> t -> Loc.t option =
fun k -> f_lift_default None (MemReach.find_simple_alias k) fun k -> f_lift_default None (MemReach.find_simple_alias k)
let find_ret_alias : t -> AliasTarget.t option = f_lift_default None MemReach.find_ret_alias let find_ret_alias : t -> AliasTarget.t option = f_lift_default None MemReach.find_ret_alias
let load_alias : Ident.t -> AliasTarget.t -> t -> t = let load_alias : Ident.t -> AliasTarget.t -> t -> t =
fun id loc -> f_lift (MemReach.load_alias id loc) fun id loc -> f_lift (MemReach.load_alias id loc)
let load_simple_alias : Ident.t -> Loc.t -> t -> t = let load_simple_alias : Ident.t -> Loc.t -> t -> t =
fun id loc -> load_alias id (AliasTarget.Simple loc) fun id loc -> load_alias id (AliasTarget.Simple loc)
let store_simple_alias : Loc.t -> Exp.t -> t -> t = let store_simple_alias : Loc.t -> Exp.t -> t -> t =
fun loc e -> f_lift (MemReach.store_simple_alias loc e) fun loc e -> f_lift (MemReach.store_simple_alias loc e)
let store_empty_alias : Val.t -> Loc.t -> Exp.t -> t -> t = let store_empty_alias : Val.t -> Loc.t -> Exp.t -> t -> t =
fun formal loc e -> f_lift (MemReach.store_empty_alias formal loc e) fun formal loc e -> f_lift (MemReach.store_empty_alias formal loc e)
let add_stack : Loc.t -> Val.t -> t -> t = fun k v -> f_lift (MemReach.add_stack k v) let add_stack : Loc.t -> Val.t -> t -> t = fun k v -> f_lift (MemReach.add_stack k v)
@ -809,11 +807,11 @@ module Mem = struct
let add_heap : Loc.t -> Val.t -> t -> t = fun k v -> f_lift (MemReach.add_heap k v) let add_heap : Loc.t -> Val.t -> t -> t = fun k v -> f_lift (MemReach.add_heap k v)
let strong_update_heap : PowLoc.t -> Val.t -> t -> t = let strong_update_heap : PowLoc.t -> Val.t -> t -> t =
fun p v -> f_lift (MemReach.strong_update_heap p v) fun p v -> f_lift (MemReach.strong_update_heap p v)
let weak_update_heap : PowLoc.t -> Val.t -> t -> t = let weak_update_heap : PowLoc.t -> Val.t -> t -> t =
fun p v -> f_lift (MemReach.weak_update_heap p v) fun p v -> f_lift (MemReach.weak_update_heap p v)
let get_return : t -> Val.t = f_lift_default Val.bot MemReach.get_return let get_return : t -> Val.t = f_lift_default Val.bot MemReach.get_return
@ -821,25 +819,25 @@ module Mem = struct
let update_mem : PowLoc.t -> Val.t -> t -> t = fun ploc v -> f_lift (MemReach.update_mem ploc v) let update_mem : PowLoc.t -> Val.t -> t -> t = fun ploc v -> f_lift (MemReach.update_mem ploc v)
let transform_mem : f:(Val.t -> Val.t) -> PowLoc.t -> t -> t = let transform_mem : f:(Val.t -> Val.t) -> PowLoc.t -> t -> t =
fun ~f ploc -> f_lift (MemReach.transform_mem ~f ploc) fun ~f ploc -> f_lift (MemReach.transform_mem ~f ploc)
let remove_temps : Ident.t list -> t -> t = fun temps -> f_lift (MemReach.remove_temps temps) let remove_temps : Ident.t list -> t -> t = fun temps -> f_lift (MemReach.remove_temps temps)
let set_prune_pairs : PrunePairs.t -> t -> t = let set_prune_pairs : PrunePairs.t -> t -> t =
fun prune_pairs -> f_lift (MemReach.set_prune_pairs prune_pairs) fun prune_pairs -> f_lift (MemReach.set_prune_pairs prune_pairs)
let apply_latest_prune : Exp.t -> t -> t = fun e -> f_lift (MemReach.apply_latest_prune e) let apply_latest_prune : Exp.t -> t -> t = fun e -> f_lift (MemReach.apply_latest_prune e)
let update_latest_prune : Exp.t -> Exp.t -> t -> t = let update_latest_prune : Exp.t -> Exp.t -> t -> t =
fun e1 e2 -> f_lift (MemReach.update_latest_prune e1 e2) fun e1 e2 -> f_lift (MemReach.update_latest_prune e1 e2)
let update_mem_in_prune : PrunePairs.t ref -> Loc.t -> Val.t -> t -> t = let update_mem_in_prune : PrunePairs.t ref -> Loc.t -> Val.t -> t -> t =
fun prune_pairs lv v m -> fun prune_pairs lv v m ->
prune_pairs := (lv, v) :: !prune_pairs ; prune_pairs := (lv, v) :: !prune_pairs ;
update_mem (PowLoc.singleton lv) v m update_mem (PowLoc.singleton lv) v m
end end
module Summary = struct module Summary = struct
@ -856,17 +854,16 @@ module Summary = struct
let pp_symbol_map : F.formatter -> t -> unit = fun fmt s -> Mem.pp_summary fmt (get_input s) let pp_symbol_map : F.formatter -> t -> unit = fun fmt s -> Mem.pp_summary fmt (get_input s)
let pp_return : F.formatter -> t -> unit = let pp_return : F.formatter -> t -> unit =
fun fmt s -> F.fprintf fmt "Return value: %a" Val.pp_summary (get_return s) fun fmt s -> F.fprintf fmt "Return value: %a" Val.pp_summary (get_return s)
let pp_summary : F.formatter -> t -> unit = let pp_summary : F.formatter -> t -> unit =
fun fmt s -> fun fmt s ->
F.fprintf fmt "%a@,%a@,%a" pp_symbol_map s pp_return s PO.ConditionSet.pp_summary F.fprintf fmt "%a@,%a@,%a" pp_symbol_map s pp_return s PO.ConditionSet.pp_summary
(get_cond_set s) (get_cond_set s)
let pp : F.formatter -> t -> unit = let pp : F.formatter -> t -> unit =
fun fmt (entry_mem, exit_mem, condition_set) -> fun fmt (entry_mem, exit_mem, condition_set) ->
F.fprintf fmt "%a@,%a@,%a@," Mem.pp entry_mem Mem.pp exit_mem PO.ConditionSet.pp F.fprintf fmt "%a@,%a@,%a@," Mem.pp entry_mem Mem.pp exit_mem PO.ConditionSet.pp condition_set
condition_set
end end

@ -91,26 +91,26 @@ module ArrayAccessCondition = struct
let get_symbols c = ItvPure.get_symbols c.idx @ ItvPure.get_symbols c.size let get_symbols c = ItvPure.get_symbols c.idx @ ItvPure.get_symbols c.size
let set_size_pos : t -> t = let set_size_pos : t -> t =
fun c -> fun c ->
let size' = ItvPure.make_positive c.size in let size' = ItvPure.make_positive c.size in
if phys_equal size' c.size then c else {c with size= size'} if phys_equal size' c.size then c else {c with size= size'}
let pp : F.formatter -> t -> unit = let pp : F.formatter -> t -> unit =
fun fmt c -> fun fmt c ->
let c = set_size_pos c in let c = set_size_pos c in
F.fprintf fmt "%a < %a" ItvPure.pp c.idx ItvPure.pp c.size F.fprintf fmt "%a < %a" ItvPure.pp c.idx ItvPure.pp c.size
let pp_description : F.formatter -> t -> unit = let pp_description : F.formatter -> t -> unit =
fun fmt c -> fun fmt c ->
let c = set_size_pos c in let c = set_size_pos c in
F.fprintf fmt "Offset: %a Size: %a" ItvPure.pp c.idx ItvPure.pp c.size F.fprintf fmt "Offset: %a Size: %a" ItvPure.pp c.idx ItvPure.pp c.size
let make : idx:ItvPure.t -> size:ItvPure.t -> t option = let make : idx:ItvPure.t -> size:ItvPure.t -> t option =
fun ~idx ~size -> fun ~idx ~size ->
if ItvPure.is_invalid idx || ItvPure.is_invalid size then None else Some {idx; size} if ItvPure.is_invalid idx || ItvPure.is_invalid size then None else Some {idx; size}
let have_similar_bounds {idx= lidx; size= lsiz} {idx= ridx; size= rsiz} = let have_similar_bounds {idx= lidx; size= lsiz} {idx= ridx; size= rsiz} =
@ -163,69 +163,68 @@ module ArrayAccessCondition = struct
let filter1 : t -> bool = let filter1 : t -> bool =
fun c -> fun c ->
ItvPure.is_top c.idx || ItvPure.is_top c.size ItvPure.is_top c.idx || ItvPure.is_top c.size || Itv.Bound.eq (ItvPure.lb c.idx) Itv.Bound.MInf
|| Itv.Bound.eq (ItvPure.lb c.idx) Itv.Bound.MInf || Itv.Bound.eq (ItvPure.lb c.size) Itv.Bound.MInf
|| Itv.Bound.eq (ItvPure.lb c.size) Itv.Bound.MInf || ItvPure.is_nat c.idx && ItvPure.is_nat c.size
|| ItvPure.is_nat c.idx && ItvPure.is_nat c.size
let filter2 : t -> bool = let filter2 : t -> bool =
fun c -> fun c ->
(* basically, alarms involving infinity are filtered *) (* basically, alarms involving infinity are filtered *)
(not (ItvPure.is_finite c.idx) || not (ItvPure.is_finite c.size)) (not (ItvPure.is_finite c.idx) || not (ItvPure.is_finite c.size))
&& (* except the following cases *) && (* except the following cases *)
not not
( Itv.Bound.is_not_infty (ItvPure.lb c.idx) ( Itv.Bound.is_not_infty (ItvPure.lb c.idx)
&& (* idx non-infty lb < 0 *) && (* idx non-infty lb < 0 *)
Itv.Bound.lt (ItvPure.lb c.idx) Itv.Bound.zero Itv.Bound.lt (ItvPure.lb c.idx) Itv.Bound.zero
|| Itv.Bound.is_not_infty (ItvPure.lb c.idx) || Itv.Bound.is_not_infty (ItvPure.lb c.idx)
&& (* idx non-infty lb > size lb *) && (* idx non-infty lb > size lb *)
Itv.Bound.gt (ItvPure.lb c.idx) (ItvPure.lb c.size) Itv.Bound.gt (ItvPure.lb c.idx) (ItvPure.lb c.size)
|| Itv.Bound.is_not_infty (ItvPure.lb c.idx) || Itv.Bound.is_not_infty (ItvPure.lb c.idx)
&& (* idx non-infty lb > size ub *) && (* idx non-infty lb > size ub *)
Itv.Bound.gt (ItvPure.lb c.idx) (ItvPure.ub c.size) Itv.Bound.gt (ItvPure.lb c.idx) (ItvPure.ub c.size)
|| Itv.Bound.is_not_infty (ItvPure.ub c.idx) || Itv.Bound.is_not_infty (ItvPure.ub c.idx)
&& (* idx non-infty ub > size lb *) && (* idx non-infty ub > size lb *)
Itv.Bound.gt (ItvPure.ub c.idx) (ItvPure.lb c.size) Itv.Bound.gt (ItvPure.ub c.idx) (ItvPure.lb c.size)
|| Itv.Bound.is_not_infty (ItvPure.ub c.idx) || Itv.Bound.is_not_infty (ItvPure.ub c.idx)
&& (* idx non-infty ub > size ub *) && (* idx non-infty ub > size ub *)
Itv.Bound.gt (ItvPure.ub c.idx) (ItvPure.ub c.size) ) Itv.Bound.gt (ItvPure.ub c.idx) (ItvPure.ub c.size) )
(* check buffer overrun and return its confidence *) (* check buffer overrun and return its confidence *)
let check : t -> IssueType.t option = let check : t -> IssueType.t option =
fun c -> fun c ->
(* idx = [il, iu], size = [sl, su], we want to check that 0 <= idx < size *) (* idx = [il, iu], size = [sl, su], we want to check that 0 <= idx < size *)
let c' = set_size_pos c in let c' = set_size_pos c in
(* if sl < 0, use sl' = 0 *) (* if sl < 0, use sl' = 0 *)
let not_overrun = ItvPure.lt_sem c'.idx c'.size in let not_overrun = ItvPure.lt_sem c'.idx c'.size in
let not_underrun = ItvPure.le_sem ItvPure.zero c'.idx in let not_underrun = ItvPure.le_sem ItvPure.zero c'.idx in
(* il >= 0 and iu < sl, definitely not an error *) (* il >= 0 and iu < sl, definitely not an error *)
if ItvPure.is_one not_overrun && ItvPure.is_one not_underrun then None if ItvPure.is_one not_overrun && ItvPure.is_one not_underrun then None
(* iu < 0 or il >= su, definitely an error *) (* iu < 0 or il >= su, definitely an error *)
else if ItvPure.is_zero not_overrun || ItvPure.is_zero not_underrun then else if ItvPure.is_zero not_overrun || ItvPure.is_zero not_underrun then
Some IssueType.buffer_overrun_l1 (* su <= iu < +oo, most probably an error *) Some IssueType.buffer_overrun_l1 (* su <= iu < +oo, most probably an error *)
else if Itv.Bound.is_not_infty (ItvPure.ub c.idx) else if Itv.Bound.is_not_infty (ItvPure.ub c.idx)
&& Itv.Bound.le (ItvPure.ub c.size) (ItvPure.ub c.idx) && Itv.Bound.le (ItvPure.ub c.size) (ItvPure.ub c.idx)
then Some IssueType.buffer_overrun_l2 (* symbolic il >= sl, probably an error *) then Some IssueType.buffer_overrun_l2 (* symbolic il >= sl, probably an error *)
else if Itv.Bound.is_symbolic (ItvPure.lb c.idx) else if Itv.Bound.is_symbolic (ItvPure.lb c.idx)
&& Itv.Bound.le (ItvPure.lb c'.size) (ItvPure.lb c.idx) && Itv.Bound.le (ItvPure.lb c'.size) (ItvPure.lb c.idx)
then Some IssueType.buffer_overrun_s2 (* other symbolic bounds are probably too noisy *) then Some IssueType.buffer_overrun_s2 (* other symbolic bounds are probably too noisy *)
else if Config.bo_debug <= 3 && (ItvPure.is_symbolic c.idx || ItvPure.is_symbolic c.size) else if Config.bo_debug <= 3 && (ItvPure.is_symbolic c.idx || ItvPure.is_symbolic c.size) then
then None None
else if filter1 c then Some IssueType.buffer_overrun_l5 else if filter1 c then Some IssueType.buffer_overrun_l5
else if filter2 c then Some IssueType.buffer_overrun_l4 else if filter2 c then Some IssueType.buffer_overrun_l4
else Some IssueType.buffer_overrun_l3 else Some IssueType.buffer_overrun_l3
let subst : Itv.Bound.t bottom_lifted Itv.SubstMap.t -> t -> t option = let subst : Itv.Bound.t bottom_lifted Itv.SubstMap.t -> t -> t option =
fun bound_map c -> fun bound_map c ->
match (ItvPure.subst c.idx bound_map, ItvPure.subst c.size bound_map) with match (ItvPure.subst c.idx bound_map, ItvPure.subst c.size bound_map) with
| NonBottom idx, NonBottom size -> | NonBottom idx, NonBottom size ->
Some {idx; size} Some {idx; size}
| _ -> | _ ->
None None
end end
module Condition = struct module Condition = struct
@ -306,27 +305,27 @@ module ConditionTrace = struct
let pp_location : F.formatter -> t -> unit = fun fmt ct -> Location.pp_file_pos fmt ct.location let pp_location : F.formatter -> t -> unit = fun fmt ct -> Location.pp_file_pos fmt ct.location
let pp : F.formatter -> t -> unit = let pp : F.formatter -> t -> unit =
fun fmt ct -> fun fmt ct ->
if Config.bo_debug <= 1 then F.fprintf fmt "at %a" pp_location ct if Config.bo_debug <= 1 then F.fprintf fmt "at %a" pp_location ct
else else
match ct.cond_trace with match ct.cond_trace with
| Inter (_, pname, location) -> | Inter (_, pname, location) ->
let pname = Typ.Procname.to_string pname in let pname = Typ.Procname.to_string pname in
F.fprintf fmt "at %a by call %s() at %a (%a)" pp_location ct pname Location.pp_file_pos F.fprintf fmt "at %a by call %s() at %a (%a)" pp_location ct pname Location.pp_file_pos
location ValTraceSet.pp ct.val_traces location ValTraceSet.pp ct.val_traces
| Intra _ -> | Intra _ ->
F.fprintf fmt "%a (%a)" pp_location ct ValTraceSet.pp ct.val_traces F.fprintf fmt "%a (%a)" pp_location ct ValTraceSet.pp ct.val_traces
let pp_description : F.formatter -> t -> unit = let pp_description : F.formatter -> t -> unit =
fun fmt ct -> fun fmt ct ->
match ct.cond_trace with match ct.cond_trace with
| Inter (_, pname, _) | Inter (_, pname, _)
when Config.bo_debug >= 1 || not (SourceFile.is_cpp_model ct.location.Location.file) -> when Config.bo_debug >= 1 || not (SourceFile.is_cpp_model ct.location.Location.file) ->
F.fprintf fmt " %@ %a by call %a " pp_location ct MF.pp_monospaced F.fprintf fmt " %@ %a by call %a " pp_location ct MF.pp_monospaced
(Typ.Procname.to_string pname ^ "()") (Typ.Procname.to_string pname ^ "()")
| _ -> | _ ->
() ()
let get_location : t -> Location.t = fun ct -> ct.location let get_location : t -> Location.t = fun ct -> ct.location
@ -334,8 +333,8 @@ module ConditionTrace = struct
let get_cond_trace : t -> cond_trace = fun ct -> ct.cond_trace let get_cond_trace : t -> cond_trace = fun ct -> ct.cond_trace
let make : Typ.Procname.t -> Location.t -> ValTraceSet.t -> t = let make : Typ.Procname.t -> Location.t -> ValTraceSet.t -> t =
fun proc_name location val_traces -> fun proc_name location val_traces ->
{proc_name; location; cond_trace= Intra proc_name; val_traces} {proc_name; location; cond_trace= Intra proc_name; val_traces}
let make_call_and_subst ~traces_caller ~caller_pname ~callee_pname location ct = let make_call_and_subst ~traces_caller ~caller_pname ~callee_pname location ct =
@ -455,23 +454,23 @@ module ConditionSet = struct
let pp_cwt fmt cwt = F.fprintf fmt "%a %a" Condition.pp cwt.cond ConditionTrace.pp cwt.trace let pp_cwt fmt cwt = F.fprintf fmt "%a %a" Condition.pp cwt.cond ConditionTrace.pp cwt.trace
let pp_summary : F.formatter -> t -> unit = let pp_summary : F.formatter -> t -> unit =
fun fmt condset -> fun fmt condset ->
let pp_sep fmt () = F.fprintf fmt ", @," in let pp_sep fmt () = F.fprintf fmt ", @," in
F.fprintf fmt "@[<v 0>Safety conditions:@," ; F.fprintf fmt "@[<v 0>Safety conditions:@," ;
F.fprintf fmt "@[<hov 2>{ " ; F.fprintf fmt "@[<hov 2>{ " ;
F.pp_print_list ~pp_sep pp_cwt fmt condset ; F.pp_print_list ~pp_sep pp_cwt fmt condset ;
F.fprintf fmt " }@]" ; F.fprintf fmt " }@]" ;
F.fprintf fmt "@]" F.fprintf fmt "@]"
let pp : Format.formatter -> t -> unit = let pp : Format.formatter -> t -> unit =
fun fmt condset -> fun fmt condset ->
let pp_sep fmt () = F.fprintf fmt ", @," in let pp_sep fmt () = F.fprintf fmt ", @," in
F.fprintf fmt "@[<v 2>Safety conditions :@," ; F.fprintf fmt "@[<v 2>Safety conditions :@," ;
F.fprintf fmt "@[<hov 1>{" ; F.fprintf fmt "@[<hov 1>{" ;
F.pp_print_list ~pp_sep pp_cwt fmt condset ; F.pp_print_list ~pp_sep pp_cwt fmt condset ;
F.fprintf fmt " }@]" ; F.fprintf fmt " }@]" ;
F.fprintf fmt "@]" F.fprintf fmt "@]"
end end
let description cond trace = let description cond trace =

@ -77,49 +77,49 @@ module Make (CFG : ProcCfg.S) = struct
let rec must_alias : Exp.t -> Exp.t -> Mem.astate -> bool = let rec must_alias : Exp.t -> Exp.t -> Mem.astate -> bool =
fun e1 e2 m -> fun e1 e2 m ->
match (e1, e2) with match (e1, e2) with
| Exp.Var x1, Exp.Var x2 -> ( | Exp.Var x1, Exp.Var x2 -> (
match (Mem.find_alias x1 m, Mem.find_alias x2 m) with match (Mem.find_alias x1 m, Mem.find_alias x2 m) with
| Some x1', Some x2' -> | Some x1', Some x2' ->
AliasTarget.equal x1' x2' AliasTarget.equal x1' x2'
| _, _ ->
false )
| Exp.UnOp (uop1, e1', _), Exp.UnOp (uop2, e2', _) ->
Unop.equal uop1 uop2 && must_alias e1' e2' m
| Exp.BinOp (bop1, e11, e12), Exp.BinOp (bop2, e21, e22) ->
Binop.equal bop1 bop2 && must_alias e11 e21 m && must_alias e12 e22 m
| Exp.Exn t1, Exp.Exn t2 ->
must_alias t1 t2 m
| Exp.Const c1, Exp.Const c2 ->
Const.equal c1 c2
| Exp.Cast (t1, e1'), Exp.Cast (t2, e2') ->
Typ.equal t1 t2 && must_alias e1' e2' m
| Exp.Lvar x1, Exp.Lvar x2 ->
Pvar.equal x1 x2
| Exp.Lfield (e1, fld1, _), Exp.Lfield (e2, fld2, _) ->
must_alias e1 e2 m && Typ.Fieldname.equal fld1 fld2
| Exp.Lindex (e11, e12), Exp.Lindex (e21, e22) ->
must_alias e11 e21 m && must_alias e12 e22 m
| Exp.Sizeof {nbytes= Some nbytes1}, Exp.Sizeof {nbytes= Some nbytes2} ->
Int.equal nbytes1 nbytes2
| ( Exp.Sizeof {typ= t1; dynamic_length= dynlen1; subtype= subt1}
, Exp.Sizeof {typ= t2; dynamic_length= dynlen2; subtype= subt2} ) ->
Typ.equal t1 t2 && must_alias_opt dynlen1 dynlen2 m
&& Int.equal (Subtype.compare subt1 subt2) 0
| _, _ -> | _, _ ->
false false )
| Exp.UnOp (uop1, e1', _), Exp.UnOp (uop2, e2', _) ->
Unop.equal uop1 uop2 && must_alias e1' e2' m
| Exp.BinOp (bop1, e11, e12), Exp.BinOp (bop2, e21, e22) ->
Binop.equal bop1 bop2 && must_alias e11 e21 m && must_alias e12 e22 m
| Exp.Exn t1, Exp.Exn t2 ->
must_alias t1 t2 m
| Exp.Const c1, Exp.Const c2 ->
Const.equal c1 c2
| Exp.Cast (t1, e1'), Exp.Cast (t2, e2') ->
Typ.equal t1 t2 && must_alias e1' e2' m
| Exp.Lvar x1, Exp.Lvar x2 ->
Pvar.equal x1 x2
| Exp.Lfield (e1, fld1, _), Exp.Lfield (e2, fld2, _) ->
must_alias e1 e2 m && Typ.Fieldname.equal fld1 fld2
| Exp.Lindex (e11, e12), Exp.Lindex (e21, e22) ->
must_alias e11 e21 m && must_alias e12 e22 m
| Exp.Sizeof {nbytes= Some nbytes1}, Exp.Sizeof {nbytes= Some nbytes2} ->
Int.equal nbytes1 nbytes2
| ( Exp.Sizeof {typ= t1; dynamic_length= dynlen1; subtype= subt1}
, Exp.Sizeof {typ= t2; dynamic_length= dynlen2; subtype= subt2} ) ->
Typ.equal t1 t2 && must_alias_opt dynlen1 dynlen2 m
&& Int.equal (Subtype.compare subt1 subt2) 0
| _, _ ->
false
and must_alias_opt : Exp.t option -> Exp.t option -> Mem.astate -> bool = and must_alias_opt : Exp.t option -> Exp.t option -> Mem.astate -> bool =
fun e1_opt e2_opt m -> fun e1_opt e2_opt m ->
match (e1_opt, e2_opt) with match (e1_opt, e2_opt) with
| Some e1, Some e2 -> | Some e1, Some e2 ->
must_alias e1 e2 m must_alias e1 e2 m
| None, None -> | None, None ->
true true
| _, _ -> | _, _ ->
false false
let comp_rev : Binop.t -> Binop.t = function let comp_rev : Binop.t -> Binop.t = function
@ -157,64 +157,64 @@ module Make (CFG : ProcCfg.S) = struct
let rec must_alias_cmp : Exp.t -> Mem.astate -> bool = let rec must_alias_cmp : Exp.t -> Mem.astate -> bool =
fun e m -> fun e m ->
match e with match e with
| Exp.BinOp (Binop.Lt, e1, e2) | Exp.BinOp (Binop.Gt, e1, e2) | Exp.BinOp (Binop.Ne, e1, e2) -> | Exp.BinOp (Binop.Lt, e1, e2) | Exp.BinOp (Binop.Gt, e1, e2) | Exp.BinOp (Binop.Ne, e1, e2) ->
must_alias e1 e2 m must_alias e1 e2 m
| Exp.BinOp (Binop.LAnd, e1, e2) -> | Exp.BinOp (Binop.LAnd, e1, e2) ->
must_alias_cmp e1 m || must_alias_cmp e2 m must_alias_cmp e1 m || must_alias_cmp e2 m
| Exp.BinOp (Binop.LOr, e1, e2) -> | Exp.BinOp (Binop.LOr, e1, e2) ->
must_alias_cmp e1 m && must_alias_cmp e2 m must_alias_cmp e1 m && must_alias_cmp e2 m
| Exp.UnOp (Unop.LNot, Exp.UnOp (Unop.LNot, e1, _), _) -> | Exp.UnOp (Unop.LNot, Exp.UnOp (Unop.LNot, e1, _), _) ->
must_alias_cmp e1 m must_alias_cmp e1 m
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Lt as c), e1, e2), _) | Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Lt as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Gt as c), e1, e2), _) | Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Gt as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Le as c), e1, e2), _) | Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Le as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Ge as c), e1, e2), _) | Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Ge as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Eq as c), e1, e2), _) | Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Eq as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Ne as c), e1, e2), _) -> | Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Ne as c), e1, e2), _) ->
must_alias_cmp (Exp.BinOp (comp_not c, e1, e2)) m must_alias_cmp (Exp.BinOp (comp_not c, e1, e2)) m
| Exp.UnOp (Unop.LNot, Exp.BinOp (Binop.LOr, e1, e2), t) -> | Exp.UnOp (Unop.LNot, Exp.BinOp (Binop.LOr, e1, e2), t) ->
let e1' = Exp.UnOp (Unop.LNot, e1, t) in let e1' = Exp.UnOp (Unop.LNot, e1, t) in
let e2' = Exp.UnOp (Unop.LNot, e2, t) in let e2' = Exp.UnOp (Unop.LNot, e2, t) in
must_alias_cmp (Exp.BinOp (Binop.LAnd, e1', e2')) m must_alias_cmp (Exp.BinOp (Binop.LAnd, e1', e2')) m
| Exp.UnOp (Unop.LNot, Exp.BinOp (Binop.LAnd, e1, e2), t) -> | Exp.UnOp (Unop.LNot, Exp.BinOp (Binop.LAnd, e1, e2), t) ->
let e1' = Exp.UnOp (Unop.LNot, e1, t) in let e1' = Exp.UnOp (Unop.LNot, e1, t) in
let e2' = Exp.UnOp (Unop.LNot, e2, t) in let e2' = Exp.UnOp (Unop.LNot, e2, t) in
must_alias_cmp (Exp.BinOp (Binop.LOr, e1', e2')) m must_alias_cmp (Exp.BinOp (Binop.LOr, e1', e2')) m
| _ -> | _ ->
false false
let rec eval : Exp.t -> Mem.astate -> Val.t = let rec eval : Exp.t -> Mem.astate -> Val.t =
fun exp mem -> fun exp mem ->
if must_alias_cmp exp mem then Val.of_int 0 if must_alias_cmp exp mem then Val.of_int 0
else else
match exp with match exp with
| Exp.Var id -> | Exp.Var id ->
Mem.find_stack (Var.of_id id |> Loc.of_var) mem Mem.find_stack (Var.of_id id |> Loc.of_var) mem
| Exp.Lvar pvar -> | Exp.Lvar pvar ->
let ploc = pvar |> Loc.of_pvar |> PowLoc.singleton in let ploc = pvar |> Loc.of_pvar |> PowLoc.singleton in
let arr = Mem.find_stack_set ploc mem in let arr = Mem.find_stack_set ploc mem in
ploc |> Val.of_pow_loc |> Val.join arr ploc |> Val.of_pow_loc |> Val.join arr
| Exp.UnOp (uop, e, _) -> | Exp.UnOp (uop, e, _) ->
eval_unop uop e mem eval_unop uop e mem
| Exp.BinOp (bop, e1, e2) -> | Exp.BinOp (bop, e1, e2) ->
eval_binop bop e1 e2 mem eval_binop bop e1 e2 mem
| Exp.Const c -> | Exp.Const c ->
eval_const c eval_const c
| Exp.Cast (_, e) -> | Exp.Cast (_, e) ->
eval e mem eval e mem
| Exp.Lfield (e, fn, _) -> | Exp.Lfield (e, fn, _) ->
eval e mem |> Val.get_array_locs |> PowLoc.append_field ~fn |> Val.of_pow_loc eval e mem |> Val.get_array_locs |> PowLoc.append_field ~fn |> Val.of_pow_loc
| Exp.Lindex (e1, e2) -> | Exp.Lindex (e1, e2) ->
eval_lindex e1 e2 mem eval_lindex e1 e2 mem
| Exp.Sizeof {nbytes= Some size} -> | Exp.Sizeof {nbytes= Some size} ->
Val.of_int size Val.of_int size
| Exp.Sizeof {typ; nbytes= None} -> | Exp.Sizeof {typ; nbytes= None} ->
Val.of_int (sizeof typ) Val.of_int (sizeof typ)
| Exp.Exn _ | Exp.Closure _ -> | Exp.Exn _ | Exp.Closure _ ->
Val.Itv.top Val.Itv.top
and eval_lindex array_exp index_exp mem = and eval_lindex array_exp index_exp mem =
@ -227,335 +227,334 @@ module Make (CFG : ProcCfg.S) = struct
and eval_unop : Unop.t -> Exp.t -> Mem.astate -> Val.t = and eval_unop : Unop.t -> Exp.t -> Mem.astate -> Val.t =
fun unop e mem -> fun unop e mem ->
let v = eval e mem in let v = eval e mem in
match unop with match unop with
| Unop.Neg -> | Unop.Neg ->
Val.neg v Val.neg v
| Unop.BNot -> | Unop.BNot ->
Val.unknown_bit v Val.unknown_bit v
| Unop.LNot -> | Unop.LNot ->
Val.lnot v Val.lnot v
and eval_binop : Binop.t -> Exp.t -> Exp.t -> Mem.astate -> Val.t = and eval_binop : Binop.t -> Exp.t -> Exp.t -> Mem.astate -> Val.t =
fun binop e1 e2 mem -> fun binop e1 e2 mem ->
let v1 = eval e1 mem in let v1 = eval e1 mem in
let v2 = eval e2 mem in let v2 = eval e2 mem in
match binop with match binop with
| Binop.PlusA -> | Binop.PlusA ->
Val.join (Val.plus v1 v2) (Val.plus_pi v1 v2) Val.join (Val.plus v1 v2) (Val.plus_pi v1 v2)
| Binop.PlusPI -> | Binop.PlusPI ->
Val.plus_pi v1 v2 Val.plus_pi v1 v2
| Binop.MinusA -> | Binop.MinusA ->
Val.joins [Val.minus v1 v2; Val.minus_pi v1 v2; Val.minus_pp v1 v2] Val.joins [Val.minus v1 v2; Val.minus_pi v1 v2; Val.minus_pp v1 v2]
| Binop.MinusPI -> | Binop.MinusPI ->
Val.minus_pi v1 v2 Val.minus_pi v1 v2
| Binop.MinusPP -> | Binop.MinusPP ->
Val.minus_pp v1 v2 Val.minus_pp v1 v2
| Binop.Mult -> | Binop.Mult ->
Val.mult v1 v2 Val.mult v1 v2
| Binop.Div -> | Binop.Div ->
Val.div v1 v2 Val.div v1 v2
| Binop.Mod -> | Binop.Mod ->
Val.mod_sem v1 v2 Val.mod_sem v1 v2
| Binop.Shiftlt -> | Binop.Shiftlt ->
Val.shiftlt v1 v2 Val.shiftlt v1 v2
| Binop.Shiftrt -> | Binop.Shiftrt ->
Val.shiftrt v1 v2 Val.shiftrt v1 v2
| Binop.Lt -> | Binop.Lt ->
Val.lt_sem v1 v2 Val.lt_sem v1 v2
| Binop.Gt -> | Binop.Gt ->
Val.gt_sem v1 v2 Val.gt_sem v1 v2
| Binop.Le -> | Binop.Le ->
Val.le_sem v1 v2 Val.le_sem v1 v2
| Binop.Ge -> | Binop.Ge ->
Val.ge_sem v1 v2 Val.ge_sem v1 v2
| Binop.Eq -> | Binop.Eq ->
Val.eq_sem v1 v2 Val.eq_sem v1 v2
| Binop.Ne -> | Binop.Ne ->
Val.ne_sem v1 v2 Val.ne_sem v1 v2
| Binop.BAnd | Binop.BXor | Binop.BOr -> | Binop.BAnd | Binop.BXor | Binop.BOr ->
Val.unknown_bit v1 Val.unknown_bit v1
| Binop.LAnd -> | Binop.LAnd ->
Val.land_sem v1 v2 Val.land_sem v1 v2
| Binop.LOr -> | Binop.LOr ->
Val.lor_sem v1 v2 Val.lor_sem v1 v2
let rec eval_locs : Exp.t -> Mem.astate -> Val.t = let rec eval_locs : Exp.t -> Mem.astate -> Val.t =
fun exp mem -> fun exp mem ->
match exp with match exp with
| Exp.Var id -> ( | Exp.Var id -> (
match Mem.find_alias id mem with match Mem.find_alias id mem with
| Some AliasTarget.Simple loc -> | Some AliasTarget.Simple loc ->
PowLoc.singleton loc |> Val.of_pow_loc PowLoc.singleton loc |> Val.of_pow_loc
| Some AliasTarget.Empty _ | None -> | Some AliasTarget.Empty _ | None ->
Val.bot ) Val.bot )
| Exp.Lvar pvar -> | Exp.Lvar pvar ->
pvar |> Loc.of_pvar |> PowLoc.singleton |> Val.of_pow_loc pvar |> Loc.of_pvar |> PowLoc.singleton |> Val.of_pow_loc
| Exp.BinOp (bop, e1, e2) -> | Exp.BinOp (bop, e1, e2) ->
eval_binop bop e1 e2 mem eval_binop bop e1 e2 mem
| Exp.Cast (_, e) -> | Exp.Cast (_, e) ->
eval_locs e mem eval_locs e mem
| Exp.Lfield (e, fn, _) -> | Exp.Lfield (e, fn, _) ->
eval e mem |> Val.get_all_locs |> PowLoc.append_field ~fn |> Val.of_pow_loc eval e mem |> Val.get_all_locs |> PowLoc.append_field ~fn |> Val.of_pow_loc
| Exp.Lindex (e1, e2) -> | Exp.Lindex (e1, e2) ->
let arr = eval e1 mem in let arr = eval e1 mem in
let idx = eval e2 mem in let idx = eval e2 mem in
Val.plus_pi arr idx Val.plus_pi arr idx
| Exp.Const _ | Exp.UnOp _ | Exp.Sizeof _ | Exp.Exn _ | Exp.Closure _ -> | Exp.Const _ | Exp.UnOp _ | Exp.Sizeof _ | Exp.Exn _ | Exp.Closure _ ->
Val.bot Val.bot
let get_allocsite : Typ.Procname.t -> CFG.node -> int -> int -> string = let get_allocsite : Typ.Procname.t -> CFG.node -> int -> int -> string =
fun proc_name node inst_num dimension -> fun proc_name node inst_num dimension ->
let proc_name = Typ.Procname.to_string proc_name in let proc_name = Typ.Procname.to_string proc_name in
let node_num = CFG.hash node |> string_of_int in let node_num = CFG.hash node |> string_of_int in
let inst_num = string_of_int inst_num in let inst_num = string_of_int inst_num in
let dimension = string_of_int dimension in let dimension = string_of_int dimension in
proc_name ^ "-" ^ node_num ^ "-" ^ inst_num ^ "-" ^ dimension |> Allocsite.make proc_name ^ "-" ^ node_num ^ "-" ^ inst_num ^ "-" ^ dimension |> Allocsite.make
let eval_array_alloc let eval_array_alloc
: Typ.Procname.t -> CFG.node -> Typ.t -> ?stride:int -> Itv.t -> Itv.t -> int -> int -> Val.t = : Typ.Procname.t -> CFG.node -> Typ.t -> ?stride:int -> Itv.t -> Itv.t -> int -> int -> Val.t =
fun pdesc node typ ?stride:stride0 offset size inst_num dimension -> fun pdesc node typ ?stride:stride0 offset size inst_num dimension ->
let allocsite = get_allocsite pdesc node inst_num dimension in let allocsite = get_allocsite pdesc node inst_num dimension in
let int_stride = match stride0 with None -> sizeof typ | Some stride -> stride in let int_stride = match stride0 with None -> sizeof typ | Some stride -> stride in
let stride = Itv.of_int int_stride in let stride = Itv.of_int int_stride in
ArrayBlk.make allocsite offset size stride |> Val.of_array_blk ArrayBlk.make allocsite offset size stride |> Val.of_array_blk
let prune_unop : PrunePairs.t ref -> Exp.t -> Mem.astate -> Mem.astate = let prune_unop : PrunePairs.t ref -> Exp.t -> Mem.astate -> Mem.astate =
fun prune_pairs e mem -> fun prune_pairs e mem ->
match e with match e with
| Exp.Var x -> ( | Exp.Var x -> (
match Mem.find_alias x mem with match Mem.find_alias x mem with
| Some AliasTarget.Simple lv -> | Some AliasTarget.Simple lv ->
let v = Mem.find_heap lv mem in let v = Mem.find_heap lv mem in
let v' = Val.prune_zero v in let v' = Val.prune_zero v in
Mem.update_mem_in_prune prune_pairs lv v' mem Mem.update_mem_in_prune prune_pairs lv v' mem
| Some AliasTarget.Empty lv -> | Some AliasTarget.Empty lv ->
let v = Mem.find_heap lv mem in let v = Mem.find_heap lv mem in
let itv_v = Itv.prune_eq (Val.get_itv v) Itv.zero in let itv_v = Itv.prune_eq (Val.get_itv v) Itv.zero in
let v' = Val.modify_itv itv_v v in let v' = Val.modify_itv itv_v v in
Mem.update_mem_in_prune prune_pairs lv v' mem Mem.update_mem_in_prune prune_pairs lv v' mem
| None -> | None ->
mem ) mem )
| Exp.UnOp (Unop.LNot, Exp.Var x, _) -> ( | Exp.UnOp (Unop.LNot, Exp.Var x, _) -> (
match Mem.find_alias x mem with match Mem.find_alias x mem with
| Some AliasTarget.Simple lv -> | Some AliasTarget.Simple lv ->
let v = Mem.find_heap lv mem in let v = Mem.find_heap lv mem in
let itv_v = Itv.prune_eq (Val.get_itv v) Itv.false_sem in let itv_v = Itv.prune_eq (Val.get_itv v) Itv.false_sem in
let v' = Val.modify_itv itv_v v in let v' = Val.modify_itv itv_v v in
Mem.update_mem_in_prune prune_pairs lv v' mem Mem.update_mem_in_prune prune_pairs lv v' mem
| Some AliasTarget.Empty lv -> | Some AliasTarget.Empty lv ->
let v = Mem.find_heap lv mem in let v = Mem.find_heap lv mem in
let itv_v = Itv.prune_comp Binop.Ge (Val.get_itv v) Itv.one in let itv_v = Itv.prune_comp Binop.Ge (Val.get_itv v) Itv.one in
let v' = Val.modify_itv itv_v v in let v' = Val.modify_itv itv_v v in
Mem.update_mem_in_prune prune_pairs lv v' mem Mem.update_mem_in_prune prune_pairs lv v' mem
| None -> | None ->
mem ) mem )
| _ -> | _ ->
mem mem
let prune_binop_left : PrunePairs.t ref -> Exp.t -> Mem.astate -> Mem.astate = let prune_binop_left : PrunePairs.t ref -> Exp.t -> Mem.astate -> Mem.astate =
fun prune_pairs e mem -> fun prune_pairs e mem ->
match e with match e with
| Exp.BinOp ((Binop.Lt as comp), Exp.Var x, e') | Exp.BinOp ((Binop.Lt as comp), Exp.Var x, e')
| Exp.BinOp ((Binop.Gt as comp), Exp.Var x, e') | Exp.BinOp ((Binop.Gt as comp), Exp.Var x, e')
| Exp.BinOp ((Binop.Le as comp), Exp.Var x, e') | Exp.BinOp ((Binop.Le as comp), Exp.Var x, e')
| Exp.BinOp ((Binop.Ge as comp), Exp.Var x, e') -> ( | Exp.BinOp ((Binop.Ge as comp), Exp.Var x, e') -> (
match Mem.find_simple_alias x mem with match Mem.find_simple_alias x mem with
| Some lv -> | Some lv ->
let v = Mem.find_heap lv mem in let v = Mem.find_heap lv mem in
let v' = Val.prune_comp comp v (eval e' mem) in let v' = Val.prune_comp comp v (eval e' mem) in
Mem.update_mem_in_prune prune_pairs lv v' mem Mem.update_mem_in_prune prune_pairs lv v' mem
| None -> | None ->
mem ) mem )
| Exp.BinOp (Binop.Eq, Exp.Var x, e') -> ( | Exp.BinOp (Binop.Eq, Exp.Var x, e') -> (
match Mem.find_simple_alias x mem with match Mem.find_simple_alias x mem with
| Some lv -> | Some lv ->
let v = Mem.find_heap lv mem in let v = Mem.find_heap lv mem in
let v' = Val.prune_eq v (eval e' mem) in let v' = Val.prune_eq v (eval e' mem) in
Mem.update_mem_in_prune prune_pairs lv v' mem Mem.update_mem_in_prune prune_pairs lv v' mem
| None -> | None ->
mem ) mem )
| Exp.BinOp (Binop.Ne, Exp.Var x, e') -> ( | Exp.BinOp (Binop.Ne, Exp.Var x, e') -> (
match Mem.find_simple_alias x mem with match Mem.find_simple_alias x mem with
| Some lv -> | Some lv ->
let v = Mem.find_heap lv mem in let v = Mem.find_heap lv mem in
let v' = Val.prune_ne v (eval e' mem) in let v' = Val.prune_ne v (eval e' mem) in
Mem.update_mem_in_prune prune_pairs lv v' mem Mem.update_mem_in_prune prune_pairs lv v' mem
| None -> | None ->
mem ) mem )
| _ -> | _ ->
mem mem
let prune_binop_right : PrunePairs.t ref -> Exp.t -> Mem.astate -> Mem.astate = let prune_binop_right : PrunePairs.t ref -> Exp.t -> Mem.astate -> Mem.astate =
fun prune_pairs e mem -> fun prune_pairs e mem ->
match e with match e with
| Exp.BinOp ((Binop.Lt as c), e', Exp.Var x) | Exp.BinOp ((Binop.Lt as c), e', Exp.Var x)
| Exp.BinOp ((Binop.Gt as c), e', Exp.Var x) | Exp.BinOp ((Binop.Gt as c), e', Exp.Var x)
| Exp.BinOp ((Binop.Le as c), e', Exp.Var x) | Exp.BinOp ((Binop.Le as c), e', Exp.Var x)
| Exp.BinOp ((Binop.Ge as c), e', Exp.Var x) | Exp.BinOp ((Binop.Ge as c), e', Exp.Var x)
| Exp.BinOp ((Binop.Eq as c), e', Exp.Var x) | Exp.BinOp ((Binop.Eq as c), e', Exp.Var x)
| Exp.BinOp ((Binop.Ne as c), e', Exp.Var x) -> | Exp.BinOp ((Binop.Ne as c), e', Exp.Var x) ->
prune_binop_left prune_pairs (Exp.BinOp (comp_rev c, Exp.Var x, e')) mem prune_binop_left prune_pairs (Exp.BinOp (comp_rev c, Exp.Var x, e')) mem
| _ -> | _ ->
mem mem
let is_unreachable_constant : Exp.t -> Mem.astate -> bool = let is_unreachable_constant : Exp.t -> Mem.astate -> bool =
fun e m -> Val.( <= ) ~lhs:(eval e m) ~rhs:(Val.of_int 0) fun e m -> Val.( <= ) ~lhs:(eval e m) ~rhs:(Val.of_int 0)
let prune_unreachable : Exp.t -> Mem.astate -> Mem.astate = let prune_unreachable : Exp.t -> Mem.astate -> Mem.astate =
fun e mem -> if is_unreachable_constant e mem then Mem.bot else mem fun e mem -> if is_unreachable_constant e mem then Mem.bot else mem
let prune : Exp.t -> Mem.astate -> Mem.astate = let prune : Exp.t -> Mem.astate -> Mem.astate =
fun e mem -> fun e mem ->
let prune_pairs = ref PrunePairs.empty in let prune_pairs = ref PrunePairs.empty in
let rec prune_helper e mem = let rec prune_helper e mem =
let mem = let mem =
mem |> prune_unreachable e |> prune_unop prune_pairs e |> prune_binop_left prune_pairs e mem |> prune_unreachable e |> prune_unop prune_pairs e |> prune_binop_left prune_pairs e
|> prune_binop_right prune_pairs e |> prune_binop_right prune_pairs e
in
match e with
| Exp.BinOp (Binop.Ne, e, Exp.Const Const.Cint i) when IntLit.iszero i ->
prune_helper e mem
| Exp.BinOp (Binop.Eq, e, Exp.Const Const.Cint i) when IntLit.iszero i ->
prune_helper (Exp.UnOp (Unop.LNot, e, None)) mem
| Exp.UnOp (Unop.Neg, Exp.Var x, _) ->
prune_helper (Exp.Var x) mem
| Exp.BinOp (Binop.LAnd, e1, e2) ->
mem |> prune_helper e1 |> prune_helper e2
| Exp.UnOp (Unop.LNot, Exp.BinOp (Binop.LOr, e1, e2), t) ->
mem |> prune_helper (Exp.UnOp (Unop.LNot, e1, t))
|> prune_helper (Exp.UnOp (Unop.LNot, e2, t))
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Lt as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Gt as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Le as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Ge as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Eq as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Ne as c), e1, e2), _) ->
prune_helper (Exp.BinOp (comp_not c, e1, e2)) mem
| _ ->
mem
in in
let mem = Mem.apply_latest_prune e mem in match e with
let mem = prune_helper e mem in | Exp.BinOp (Binop.Ne, e, Exp.Const Const.Cint i) when IntLit.iszero i ->
Mem.set_prune_pairs !prune_pairs mem prune_helper e mem
| Exp.BinOp (Binop.Eq, e, Exp.Const Const.Cint i) when IntLit.iszero i ->
prune_helper (Exp.UnOp (Unop.LNot, e, None)) mem
| Exp.UnOp (Unop.Neg, Exp.Var x, _) ->
prune_helper (Exp.Var x) mem
| Exp.BinOp (Binop.LAnd, e1, e2) ->
mem |> prune_helper e1 |> prune_helper e2
| Exp.UnOp (Unop.LNot, Exp.BinOp (Binop.LOr, e1, e2), t) ->
mem |> prune_helper (Exp.UnOp (Unop.LNot, e1, t))
|> prune_helper (Exp.UnOp (Unop.LNot, e2, t))
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Lt as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Gt as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Le as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Ge as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Eq as c), e1, e2), _)
| Exp.UnOp (Unop.LNot, Exp.BinOp ((Binop.Ne as c), e1, e2), _) ->
prune_helper (Exp.BinOp (comp_not c, e1, e2)) mem
| _ ->
mem
in
let mem = Mem.apply_latest_prune e mem in
let mem = prune_helper e mem in
Mem.set_prune_pairs !prune_pairs mem
let get_formals : Procdesc.t -> (Pvar.t * Typ.t) list = let get_formals : Procdesc.t -> (Pvar.t * Typ.t) list =
fun pdesc -> fun pdesc ->
let proc_name = Procdesc.get_proc_name pdesc in let proc_name = Procdesc.get_proc_name pdesc in
Procdesc.get_formals pdesc |> List.map ~f:(fun (name, typ) -> (Pvar.mk name proc_name, typ)) Procdesc.get_formals pdesc |> List.map ~f:(fun (name, typ) -> (Pvar.mk name proc_name, typ))
let get_matching_pairs let get_matching_pairs
: Tenv.t -> Val.t -> Val.t -> Typ.t -> Mem.astate -> Mem.astate : Tenv.t -> Val.t -> Val.t -> Typ.t -> Mem.astate -> Mem.astate
-> callee_ret_alias:AliasTarget.t option -> callee_ret_alias:AliasTarget.t option
-> (Itv.Bound.t * Itv.Bound.t bottom_lifted * TraceSet.t) list * AliasTarget.t option = -> (Itv.Bound.t * Itv.Bound.t bottom_lifted * TraceSet.t) list * AliasTarget.t option =
fun tenv formal actual typ caller_mem callee_mem ~callee_ret_alias -> fun tenv formal actual typ caller_mem callee_mem ~callee_ret_alias ->
let get_itv v = Val.get_itv v in let get_itv v = Val.get_itv v in
let get_offset v = v |> Val.get_array_blk |> ArrayBlk.offsetof in let get_offset v = v |> Val.get_array_blk |> ArrayBlk.offsetof in
let get_size v = v |> Val.get_array_blk |> ArrayBlk.sizeof in let get_size v = v |> Val.get_array_blk |> ArrayBlk.sizeof in
let get_field_name (fn, _, _) = fn in let get_field_name (fn, _, _) = fn in
let append_field v fn = PowLoc.append_field (Val.get_all_locs v) ~fn in let append_field v fn = PowLoc.append_field (Val.get_all_locs v) ~fn in
let deref_field v fn mem = Mem.find_heap_set (append_field v fn) mem in let deref_field v fn mem = Mem.find_heap_set (append_field v fn) mem in
let deref_ptr v mem = let deref_ptr v mem =
let array_locs = Val.get_array_locs v in let array_locs = Val.get_array_locs v in
let locs = if PowLoc.is_empty array_locs then Val.get_pow_loc v else array_locs in let locs = if PowLoc.is_empty array_locs then Val.get_pow_loc v else array_locs in
Mem.find_heap_set locs mem Mem.find_heap_set locs mem
in in
let ret_alias = ref None in let ret_alias = ref None in
let add_ret_alias v1 v2 = let add_ret_alias v1 v2 =
match callee_ret_alias with match callee_ret_alias with
| Some ret_loc -> | Some ret_loc ->
if PowLoc.is_singleton v1 && PowLoc.is_singleton v2 if PowLoc.is_singleton v1 && PowLoc.is_singleton v2
&& AliasTarget.use (PowLoc.min_elt v1) ret_loc && AliasTarget.use (PowLoc.min_elt v1) ret_loc
then ret_alias := Some (AliasTarget.replace (PowLoc.min_elt v2) ret_loc) then ret_alias := Some (AliasTarget.replace (PowLoc.min_elt v2) ret_loc)
| None -> | None ->
() ()
in in
let add_pair_itv itv1 itv2 traces l = let add_pair_itv itv1 itv2 traces l =
let open Itv in let open Itv in
if itv1 <> bot && itv1 <> top then if itv1 <> bot && itv1 <> top then
if Itv.eq itv2 bot then if Itv.eq itv2 bot then
(lb itv1, Bottom, TraceSet.empty) :: (ub itv1, Bottom, TraceSet.empty) :: l (lb itv1, Bottom, TraceSet.empty) :: (ub itv1, Bottom, TraceSet.empty) :: l
else else (lb itv1, NonBottom (lb itv2), traces) :: (ub itv1, NonBottom (ub itv2), traces) :: l
(lb itv1, NonBottom (lb itv2), traces) :: (ub itv1, NonBottom (ub itv2), traces) :: l else l
else l in
in let add_pair_val v1 v2 pairs =
let add_pair_val v1 v2 pairs = add_ret_alias (Val.get_all_locs v1) (Val.get_all_locs v2) ;
add_ret_alias (Val.get_all_locs v1) (Val.get_all_locs v2) ; pairs |> add_pair_itv (get_itv v1) (get_itv v2) (Val.get_traces v2)
pairs |> add_pair_itv (get_itv v1) (get_itv v2) (Val.get_traces v2) |> add_pair_itv (get_offset v1) (get_offset v2) (Val.get_traces v2)
|> add_pair_itv (get_offset v1) (get_offset v2) (Val.get_traces v2) |> add_pair_itv (get_size v1) (get_size v2) (Val.get_traces v2)
|> add_pair_itv (get_size v1) (get_size v2) (Val.get_traces v2) in
in let add_pair_field v1 v2 pairs fn =
let add_pair_field v1 v2 pairs fn = add_ret_alias (append_field v1 fn) (append_field v2 fn) ;
add_ret_alias (append_field v1 fn) (append_field v2 fn) ; let v1' = deref_field v1 fn callee_mem in
let v1' = deref_field v1 fn callee_mem in let v2' = deref_field v2 fn caller_mem in
let v2' = deref_field v2 fn caller_mem in add_pair_val v1' v2' pairs
add_pair_val v1' v2' pairs in
in let add_pair_ptr typ v1 v2 pairs =
let add_pair_ptr typ v1 v2 pairs = add_ret_alias (Val.get_all_locs v1) (Val.get_all_locs v2) ;
add_ret_alias (Val.get_all_locs v1) (Val.get_all_locs v2) ; match typ.Typ.desc with
match typ.Typ.desc with | Typ.Tptr ({desc= Tstruct typename}, _) -> (
| Typ.Tptr ({desc= Tstruct typename}, _) -> ( match Tenv.lookup tenv typename with
match Tenv.lookup tenv typename with | Some str ->
| Some str -> let fns = List.map ~f:get_field_name str.Typ.Struct.fields in
let fns = List.map ~f:get_field_name str.Typ.Struct.fields in List.fold ~f:(add_pair_field v1 v2) ~init:pairs fns
List.fold ~f:(add_pair_field v1 v2) ~init:pairs fns
| _ ->
pairs )
| Typ.Tptr (_, _) ->
let v1' = deref_ptr v1 callee_mem in
let v2' = deref_ptr v2 caller_mem in
add_pair_val v1' v2' pairs
| _ -> | _ ->
pairs pairs )
in | Typ.Tptr (_, _) ->
let pairs = [] |> add_pair_val formal actual |> add_pair_ptr typ formal actual in let v1' = deref_ptr v1 callee_mem in
(pairs, !ret_alias) let v2' = deref_ptr v2 caller_mem in
add_pair_val v1' v2' pairs
| _ ->
pairs
in
let pairs = [] |> add_pair_val formal actual |> add_pair_ptr typ formal actual in
(pairs, !ret_alias)
let subst_map_of_pairs let subst_map_of_pairs
: (Itv.Bound.t * Itv.Bound.t bottom_lifted * TraceSet.t) list : (Itv.Bound.t * Itv.Bound.t bottom_lifted * TraceSet.t) list
-> Itv.Bound.t bottom_lifted Itv.SubstMap.t * TraceSet.t Itv.SubstMap.t = -> Itv.Bound.t bottom_lifted Itv.SubstMap.t * TraceSet.t Itv.SubstMap.t =
fun pairs -> fun pairs ->
let add_pair (bound_map, trace_map) (formal, actual, traces) = let add_pair (bound_map, trace_map) (formal, actual, traces) =
match formal with match formal with
| Itv.Bound.Linear (_, se1) when Itv.SymLinear.is_zero se1 -> | Itv.Bound.Linear (_, se1) when Itv.SymLinear.is_zero se1 ->
(bound_map, trace_map) (bound_map, trace_map)
| Itv.Bound.Linear (0, se1) -> | Itv.Bound.Linear (0, se1) ->
let symbol = Itv.SymLinear.get_one_symbol se1 in let symbol = Itv.SymLinear.get_one_symbol se1 in
(Itv.SubstMap.add symbol actual bound_map, Itv.SubstMap.add symbol traces trace_map) (Itv.SubstMap.add symbol actual bound_map, Itv.SubstMap.add symbol traces trace_map)
| Itv.Bound.MinMax (0, Itv.Bound.Plus, Itv.Bound.Max, 0, symbol) -> | Itv.Bound.MinMax (0, Itv.Bound.Plus, Itv.Bound.Max, 0, symbol) ->
(Itv.SubstMap.add symbol actual bound_map, Itv.SubstMap.add symbol traces trace_map) (Itv.SubstMap.add symbol actual bound_map, Itv.SubstMap.add symbol traces trace_map)
| _ -> | _ ->
assert false assert false
in in
List.fold ~f:add_pair ~init:(Itv.SubstMap.empty, Itv.SubstMap.empty) pairs List.fold ~f:add_pair ~init:(Itv.SubstMap.empty, Itv.SubstMap.empty) pairs
let rec list_fold2_def let rec list_fold2_def
: default:Val.t -> f:('a -> Val.t -> 'b -> 'b) -> 'a list -> Val.t list -> init:'b -> 'b = : default:Val.t -> f:('a -> Val.t -> 'b -> 'b) -> 'a list -> Val.t list -> init:'b -> 'b =
fun ~default ~f xs ys ~init:acc -> fun ~default ~f xs ys ~init:acc ->
match (xs, ys) with match (xs, ys) with
| [], _ -> | [], _ ->
acc acc
| x :: xs', [] -> | x :: xs', [] ->
list_fold2_def ~default ~f xs' ys ~init:(f x default acc) list_fold2_def ~default ~f xs' ys ~init:(f x default acc)
| [x], _ :: _ -> | [x], _ :: _ ->
f x (List.fold ~f:Val.join ~init:Val.bot ys) acc f x (List.fold ~f:Val.join ~init:Val.bot ys) acc
| x :: xs', y :: ys' -> | x :: xs', y :: ys' ->
list_fold2_def ~default ~f xs' ys' ~init:(f x y acc) list_fold2_def ~default ~f xs' ys' ~init:(f x y acc)
let get_subst_map let get_subst_map
@ -563,18 +562,18 @@ module Make (CFG : ProcCfg.S) = struct
-> callee_ret_alias:AliasTarget.t option -> callee_ret_alias:AliasTarget.t option
-> (Itv.Bound.t bottom_lifted Itv.SubstMap.t * TraceSet.t Itv.SubstMap.t) -> (Itv.Bound.t bottom_lifted Itv.SubstMap.t * TraceSet.t Itv.SubstMap.t)
* AliasTarget.t option = * AliasTarget.t option =
fun tenv callee_pdesc params caller_mem callee_entry_mem ~callee_ret_alias -> fun tenv callee_pdesc params caller_mem callee_entry_mem ~callee_ret_alias ->
let add_pair (formal, typ) actual (l, ret_alias) = let add_pair (formal, typ) actual (l, ret_alias) =
let formal = Mem.find_heap (Loc.of_pvar formal) callee_entry_mem in let formal = Mem.find_heap (Loc.of_pvar formal) callee_entry_mem in
let new_matching, ret_alias' = let new_matching, ret_alias' =
get_matching_pairs tenv formal actual typ caller_mem callee_entry_mem ~callee_ret_alias get_matching_pairs tenv formal actual typ caller_mem callee_entry_mem ~callee_ret_alias
in
(List.rev_append new_matching l, Option.first_some ret_alias ret_alias')
in
let formals = get_formals callee_pdesc in
let actuals = List.map ~f:(fun (a, _) -> eval a caller_mem) params in
let pairs, ret_alias =
list_fold2_def ~default:Val.Itv.top ~f:add_pair formals actuals ~init:([], None)
in in
(subst_map_of_pairs pairs, ret_alias) (List.rev_append new_matching l, Option.first_some ret_alias ret_alias')
in
let formals = get_formals callee_pdesc in
let actuals = List.map ~f:(fun (a, _) -> eval a caller_mem) params in
let pairs, ret_alias =
list_fold2_def ~default:Val.Itv.top ~f:add_pair formals actuals ~init:([], None)
in
(subst_map_of_pairs pairs, ret_alias)
end end

@ -31,26 +31,26 @@ module BoTrace = struct
let append x y = {length= x.length + y.length; trace= x.trace @ y.trace} let append x y = {length= x.length + y.length; trace= x.trace @ y.trace}
let pp_elem : F.formatter -> elem -> unit = let pp_elem : F.formatter -> elem -> unit =
fun fmt elem -> fun fmt elem ->
match elem with match elem with
| Assign location -> | Assign location ->
F.fprintf fmt "Assign (%a)" Location.pp_file_pos location F.fprintf fmt "Assign (%a)" Location.pp_file_pos location
| ArrDecl location -> | ArrDecl location ->
F.fprintf fmt "ArrDecl (%a)" Location.pp_file_pos location F.fprintf fmt "ArrDecl (%a)" Location.pp_file_pos location
| Call location -> | Call location ->
F.fprintf fmt "Call (%a)" Location.pp_file_pos location F.fprintf fmt "Call (%a)" Location.pp_file_pos location
| Return location -> | Return location ->
F.fprintf fmt "Return (%a)" Location.pp_file_pos location F.fprintf fmt "Return (%a)" Location.pp_file_pos location
| SymAssign location -> | SymAssign location ->
F.fprintf fmt "SymAssign (%a)" Location.pp_file_pos location F.fprintf fmt "SymAssign (%a)" Location.pp_file_pos location
| ArrAccess location -> | ArrAccess location ->
F.fprintf fmt "ArrAccess (%a)" Location.pp_file_pos location F.fprintf fmt "ArrAccess (%a)" Location.pp_file_pos location
let pp : F.formatter -> t -> unit = let pp : F.formatter -> t -> unit =
fun fmt t -> fun fmt t ->
let pp_sep fmt () = F.fprintf fmt " :: " in let pp_sep fmt () = F.fprintf fmt " :: " in
F.pp_print_list ~pp_sep pp_elem fmt t.trace F.pp_print_list ~pp_sep pp_elem fmt t.trace
end end
module Set = struct module Set = struct

@ -89,21 +89,21 @@ module Make (CFG : ProcCfg.S) = struct
: decl_local:decl_local -> Typ.Procname.t -> CFG.node -> Location.t -> Loc.t -> Typ.t : decl_local:decl_local -> Typ.Procname.t -> CFG.node -> Location.t -> Loc.t -> Typ.t
-> length:IntLit.t option -> ?stride:int -> inst_num:int -> dimension:int -> length:IntLit.t option -> ?stride:int -> inst_num:int -> dimension:int
-> Dom.Mem.astate -> Dom.Mem.astate * int = -> Dom.Mem.astate -> Dom.Mem.astate * int =
fun ~decl_local pname node location loc typ ~length ?stride ~inst_num ~dimension mem -> fun ~decl_local pname node location loc typ ~length ?stride ~inst_num ~dimension mem ->
let size = Option.value_map ~default:Itv.top ~f:Itv.of_int_lit length in let size = Option.value_map ~default:Itv.top ~f:Itv.of_int_lit length in
let arr = let arr =
Sem.eval_array_alloc pname node typ Itv.zero size ?stride inst_num dimension Sem.eval_array_alloc pname node typ Itv.zero size ?stride inst_num dimension
|> Dom.Val.add_trace_elem (Trace.ArrDecl location) |> Dom.Val.add_trace_elem (Trace.ArrDecl location)
in in
let mem = let mem =
if Int.equal dimension 1 then Dom.Mem.add_stack loc arr mem if Int.equal dimension 1 then Dom.Mem.add_stack loc arr mem
else Dom.Mem.add_heap loc arr mem else Dom.Mem.add_heap loc arr mem
in in
let loc = Loc.of_allocsite (Sem.get_allocsite pname node inst_num dimension) in let loc = Loc.of_allocsite (Sem.get_allocsite pname node inst_num dimension) in
let mem, _ = let mem, _ =
decl_local pname node location loc typ ~inst_num ~dimension:(dimension + 1) mem decl_local pname node location loc typ ~inst_num ~dimension:(dimension + 1) mem
in in
(mem, inst_num + 1) (mem, inst_num + 1)
type decl_sym_val = type decl_sym_val =
@ -114,21 +114,21 @@ module Make (CFG : ProcCfg.S) = struct
: decl_sym_val:decl_sym_val -> Typ.Procname.t -> Tenv.t -> CFG.node -> Location.t : decl_sym_val:decl_sym_val -> Typ.Procname.t -> Tenv.t -> CFG.node -> Location.t
-> depth:int -> Loc.t -> Typ.t -> ?offset:Itv.t -> ?size:Itv.t -> inst_num:int -> depth:int -> Loc.t -> Typ.t -> ?offset:Itv.t -> ?size:Itv.t -> inst_num:int
-> new_sym_num:counter -> new_alloc_num:counter -> Dom.Mem.astate -> Dom.Mem.astate = -> new_sym_num:counter -> new_alloc_num:counter -> Dom.Mem.astate -> Dom.Mem.astate =
fun ~decl_sym_val pname tenv node location ~depth loc typ ?offset ?size ~inst_num fun ~decl_sym_val pname tenv node location ~depth loc typ ?offset ?size ~inst_num ~new_sym_num
~new_sym_num ~new_alloc_num mem -> ~new_alloc_num mem ->
let option_value opt_x default_f = match opt_x with Some x -> x | None -> default_f () in let option_value opt_x default_f = match opt_x with Some x -> x | None -> default_f () in
let itv_make_sym () = Itv.make_sym pname new_sym_num in let itv_make_sym () = Itv.make_sym pname new_sym_num in
let offset = option_value offset itv_make_sym in let offset = option_value offset itv_make_sym in
let size = option_value size itv_make_sym in let size = option_value size itv_make_sym in
let alloc_num = new_alloc_num () in let alloc_num = new_alloc_num () in
let elem = Trace.SymAssign location in let elem = Trace.SymAssign location in
let arr = let arr =
Sem.eval_array_alloc pname node typ offset size inst_num alloc_num Sem.eval_array_alloc pname node typ offset size inst_num alloc_num
|> Dom.Val.add_trace_elem elem |> Dom.Val.add_trace_elem elem
in in
let mem = Dom.Mem.add_heap loc arr mem in let mem = Dom.Mem.add_heap loc arr mem in
let deref_loc = Loc.of_allocsite (Sem.get_allocsite pname node inst_num alloc_num) in let deref_loc = Loc.of_allocsite (Sem.get_allocsite pname node inst_num alloc_num) in
decl_sym_val pname tenv node location ~depth deref_loc typ mem decl_sym_val pname tenv node location ~depth deref_loc typ mem
let init_array_fields tenv pname node typ locs ?dyn_length mem = let init_array_fields tenv pname node typ locs ?dyn_length mem =

File diff suppressed because it is too large Load Diff

@ -177,7 +177,10 @@ let checker {Callbacks.proc_desc; tenv; get_proc_desc; summary} : Specs.summary
( match loaded_stacktraces with ( match loaded_stacktraces with
| None -> | None ->
L.(die UserError) L.(die UserError)
"Missing command line option. Either '--stacktrace stack.json' or '--stacktrace-dir ./dir' must be used when running '-a crashcontext'. This options expects a JSON formated stack trace or a directory containing multiple such traces, respectively. See tests/codetoanalyze/java/crashcontext/*.json for examples of the expected format." "Missing command line option. Either '--stacktrace stack.json' or '--stacktrace-dir \
./dir' must be used when running '-a crashcontext'. This options expects a JSON formated \
stack trace or a directory containing multiple such traces, respectively. See \
tests/codetoanalyze/java/crashcontext/*.json for examples of the expected format."
| Some stacktraces -> | Some stacktraces ->
let extras = {get_proc_desc; stacktraces} in let extras = {get_proc_desc; stacktraces} in
ignore (Analyzer.exec_pdesc (ProcData.make proc_desc tenv extras) ~initial:Domain.empty) ) ; ignore (Analyzer.exec_pdesc (ProcData.make proc_desc tenv extras) ~initial:Domain.empty) ) ;

@ -130,13 +130,15 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
if is_direct_dereference then if is_direct_dereference then
(* direct dereference without intermediate variable *) (* direct dereference without intermediate variable *)
F.asprintf F.asprintf
"The return value of %s is annotated with %a and is dereferenced without being checked for null at %a" "The return value of %s is annotated with %a and is dereferenced without being \
checked for null at %a"
(MF.monospaced_to_string simplified_pname) (MF.monospaced_to_string simplified_pname)
MF.pp_monospaced annotation Location.pp loc MF.pp_monospaced annotation Location.pp loc
else else
(* dereference with intermediate variable *) (* dereference with intermediate variable *)
F.asprintf F.asprintf
"Variable %a is indirectly annotated with %a (source %a) and is dereferenced without being checked for null at %a" "Variable %a is indirectly annotated with %a (source %a) and is dereferenced without \
being checked for null at %a"
(MF.wrap_monospaced AccessPath.pp) (MF.wrap_monospaced AccessPath.pp)
ap MF.pp_monospaced annotation (MF.wrap_monospaced CallSite.pp) call_site Location.pp ap MF.pp_monospaced annotation (MF.wrap_monospaced CallSite.pp) call_site Location.pp
loc loc

@ -57,7 +57,8 @@ module Make (Spec : Spec) : S = struct
(* failsafe for accidental non-finite height domains *) (* failsafe for accidental non-finite height domains *)
if num_iters >= iters_befor_timeout then if num_iters >= iters_befor_timeout then
L.(die InternalError) L.(die InternalError)
"Stopping analysis after 1000 iterations without convergence. Make sure your domain is finite height." "Stopping analysis after 1000 iterations without convergence. Make sure your domain is \
finite height."
else widen ~prev ~next ~num_iters else widen ~prev ~next ~num_iters
end end

@ -440,6 +440,7 @@ module PathSet (Config : Config) = struct
let mem access_path tree = let mem access_path tree =
match get_node access_path tree with None -> false | Some (is_mem, _) -> is_mem match get_node access_path tree with None -> false | Some (is_mem, _) -> is_mem
(* print as a set of paths rather than a map of paths to bools *) (* print as a set of paths rather than a map of paths to bools *)
let pp fmt tree = let pp fmt tree =
let collect_path acc access_path (is_mem, _) = if is_mem then access_path :: acc else acc in let collect_path acc access_path (is_mem, _) = if is_mem then access_path :: acc else acc in

@ -34,7 +34,8 @@ let check_immutable_cast tenv curr_pname curr_pdesc typ_expected typ_found_opt l
if in_casts name_expected name_given then if in_casts name_expected name_given then
let description = let description =
Format.asprintf Format.asprintf
"Method %s returns %a but the return type is %a. Make sure that users of this method do not try to modify the collection." "Method %s returns %a but the return type is %a. Make sure that users of this \
method do not try to modify the collection."
(Typ.Procname.to_simplified_string curr_pname) (Typ.Procname.to_simplified_string curr_pname)
Typ.Name.pp name_given Typ.Name.pp name_expected Typ.Name.pp name_given Typ.Name.pp name_expected
in in

@ -7,13 +7,13 @@
* of patent rights can be found in the PATENTS file in the same directory. * of patent rights can be found in the PATENTS file in the same directory.
*) *)
(** Raised when the parser encounters a violation of a certain invariant *)
exception ALParserInvariantViolationException of string exception ALParserInvariantViolationException of string
(** Raised when the parser encounters a violation of a certain invariant *)
type exc_info type exc_info
(** Raised when any exception from the lexer/parser of AL is caught, to include source-location info *)
exception ALFileException of exc_info exception ALFileException of exc_info
(** Raised when any exception from the lexer/parser of AL is caught, to include source-location info *)
val create_exc_info : string -> Lexing.lexbuf -> exc_info val create_exc_info : string -> Lexing.lexbuf -> exc_info

@ -118,21 +118,21 @@ let run_clang clang_command read =
let run_plugin_and_frontend source_path frontend clang_cmd = let run_plugin_and_frontend source_path frontend clang_cmd =
let clang_plugin_cmd = ClangCommand.with_plugin_args clang_cmd in let clang_plugin_cmd = ClangCommand.with_plugin_args clang_cmd in
( if debug_mode then if debug_mode then (
(* -cc1 clang commands always set -o explicitly *) (* -cc1 clang commands always set -o explicitly *)
let basename = source_path ^ ".ast" in let basename = source_path ^ ".ast" in
(* Emit the clang command with the extra args piped to infer-as-clang *) (* Emit the clang command with the extra args piped to infer-as-clang *)
let frontend_script_fname = Printf.sprintf "%s.sh" basename in let frontend_script_fname = Printf.sprintf "%s.sh" basename in
let debug_script_out = Out_channel.create frontend_script_fname in let debug_script_out = Out_channel.create frontend_script_fname in
let debug_script_fmt = Format.formatter_of_out_channel debug_script_out in let debug_script_fmt = Format.formatter_of_out_channel debug_script_out in
let biniou_fname = Printf.sprintf "%s.biniou" basename in let biniou_fname = Printf.sprintf "%s.biniou" basename in
Format.fprintf debug_script_fmt "%s \\@\n > %s@\n" Format.fprintf debug_script_fmt "%s \\@\n > %s@\n"
(ClangCommand.command_to_run clang_plugin_cmd) (ClangCommand.command_to_run clang_plugin_cmd)
biniou_fname ; biniou_fname ;
Format.fprintf debug_script_fmt Format.fprintf debug_script_fmt
"bdump -x -d \"%s/clang_ast.dict\" -w '!!DUMMY!!' %s \\@\n > %s.bdump" Config.etc_dir "bdump -x -d \"%s/clang_ast.dict\" -w '!!DUMMY!!' %s \\@\n > %s.bdump" Config.etc_dir
biniou_fname basename ; biniou_fname basename ;
Out_channel.close debug_script_out ) ; Out_channel.close debug_script_out ) ;
run_clang clang_plugin_cmd frontend run_clang clang_plugin_cmd frontend

@ -119,8 +119,13 @@ let exec_action_item ~prog ~args = function
(* An error in the output of `clang -### ...`. Outputs the error and fail. This is because (* An error in the output of `clang -### ...`. Outputs the error and fail. This is because
`clang -###` pretty much never fails, but warns of failures on stderr instead. *) `clang -###` pretty much never fails, but warns of failures on stderr instead. *)
L.(die UserError) L.(die UserError)
"Failed to execute compilation command:@\n'%s' %a@\n@\nError message:@\n%s@\n@\n*** Infer needs a working compilation command to run." "Failed to execute compilation command:@\n\
prog Pp.cli_args args error '%s' %a@\n\
@\n\
Error message:@\n\
%s@\n\
@\n\
*** Infer needs a working compilation command to run." prog Pp.cli_args args error
| ClangWarning warning -> | ClangWarning warning ->
L.external_warning "%s@\n" warning L.external_warning "%s@\n" warning
| Command clang_cmd -> | Command clang_cmd ->
@ -156,6 +161,9 @@ let exe ~prog ~args =
will fail with the appropriate error message from clang instead of silently analyzing 0 will fail with the appropriate error message from clang instead of silently analyzing 0
files. *) files. *)
L.(debug Capture Quiet) L.(debug Capture Quiet)
"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 ~sep:" " @@ prog :: args) ; (String.concat ~sep:" " @@ prog :: args) ;
Process.create_process_and_wait ~prog ~args ) Process.create_process_and_wait ~prog ~args )

@ -185,7 +185,8 @@ let component_factory_function_advice context an =
; description= "Break out composite components" ; description= "Break out composite components"
; suggestion= ; suggestion=
Some Some
"Prefer subclassing CKCompositeComponent to static helper functions that return a CKComponent subclass." "Prefer subclassing CKCompositeComponent to static helper functions that return \
a CKComponent subclass."
; doc_url= None ; doc_url= None
; loc= CFrontend_checkers.location_from_dinfo context decl_info } ; loc= CFrontend_checkers.location_from_dinfo context decl_info }
else None else None
@ -298,7 +299,8 @@ let component_with_multiple_factory_methods_advice context an =
; description= "Avoid Overrides" ; description= "Avoid Overrides"
; suggestion= ; suggestion=
Some Some
"Instead, always expose all parameters in a single designated initializer and document which are optional." "Instead, always expose all parameters in a single designated initializer and \
document which are optional."
; doc_url= None ; doc_url= None
; loc= CFrontend_checkers.location_from_decl context meth_decl } ) ; loc= CFrontend_checkers.location_from_decl context meth_decl } )
(List.drop factory_methods 1) (List.drop factory_methods 1)

@ -172,8 +172,10 @@ let unary_operation_instruction translation_unit_context uoi e typ loc =
| `Real | `Imag | `Extension | `Coawait -> | `Real | `Imag | `Extension | `Coawait ->
let uok = Clang_ast_j.string_of_unary_operator_kind uoi.Clang_ast_t.uoi_kind in let uok = Clang_ast_j.string_of_unary_operator_kind uoi.Clang_ast_t.uoi_kind in
L.(debug Capture Medium) L.(debug Capture Medium)
"@\nWARNING: Missing translation for Unary Operator Kind %s. The construct has been ignored...@\n" "@\n\
uok ; WARNING: Missing translation for Unary Operator Kind %s. The construct has been \
ignored...@\n\
" uok ;
(e, []) (e, [])

@ -562,13 +562,14 @@ let get_superclass_curr_class_objc_from_decl (decl: Clang_ast_t.decl) =
otdi.otdi_super otdi.otdi_super
| _ -> | _ ->
Logging.die InternalError Logging.die InternalError
"Expected that ObjCImplementationDecl always has a pointer to it's interface, but wasn't the case with %s" "Expected that ObjCImplementationDecl always has a pointer to it's interface, but \
ni.Clang_ast_t.ni_name ) wasn't the case with %s" ni.Clang_ast_t.ni_name )
| ObjCCategoryDecl (_, _, _, _, ocdi) -> | ObjCCategoryDecl (_, _, _, _, ocdi) ->
ocdi.odi_class_interface ocdi.odi_class_interface
| ObjCCategoryImplDecl (_, _, _, _, ocidi) -> | ObjCCategoryImplDecl (_, _, _, _, ocidi) ->
ocidi.ocidi_class_interface ocidi.ocidi_class_interface
| decl -> | decl ->
Logging.die InternalError Logging.die InternalError
"Expected to be called only with ObjCInterfaceDecl, ObjCImplementationDecl, ObjCCategoryDecl or ObjCCategoryImplDecl, but got %s" "Expected to be called only with ObjCInterfaceDecl, ObjCImplementationDecl, \
ObjCCategoryDecl or ObjCCategoryImplDecl, but got %s"
(Clang_ast_proj.get_decl_kind_string decl) (Clang_ast_proj.get_decl_kind_string decl)

@ -52,8 +52,8 @@ let decl_ref_or_selector_name an =
"The reference " ^ Ctl_parser_types.ast_node_name decl_an "The reference " ^ Ctl_parser_types.ast_node_name decl_an
| _ -> | _ ->
L.(die ExternalError) L.(die ExternalError)
"decl_ref_or_selector_name must be called with a DeclRefExpr or an ObjCMessageExpr, but got %s" "decl_ref_or_selector_name must be called with a DeclRefExpr or an ObjCMessageExpr, but \
(tag_name_of_node an) got %s" (tag_name_of_node an)
let iphoneos_target_sdk_version context _ = let iphoneos_target_sdk_version context _ =

@ -25,7 +25,9 @@ let filter_parsed_linters_developer parsed_linters =
match Config.linter with match Config.linter with
| None -> | None ->
L.(die UserError) L.(die UserError)
"In linters developer mode you should debug only one linter at a time. This is important for debugging the rule. Pass the flag --linter <name> to specify the linter you want to debug." "In linters developer mode you should debug only one linter at a time. This is \
important for debugging the rule. Pass the flag --linter <name> to specify the linter \
you want to debug."
| Some lint -> | Some lint ->
List.filter ~f:(fun (rule: linter) -> String.equal rule.issue_desc.id lint) parsed_linters List.filter ~f:(fun (rule: linter) -> String.equal rule.issue_desc.id lint) parsed_linters
else parsed_linters else parsed_linters

@ -275,8 +275,8 @@ let get_superclass_curr_class_objc context =
CAst_utils.get_superclass_curr_class_objc_from_decl decl CAst_utils.get_superclass_curr_class_objc_from_decl decl
| None -> | None ->
Logging.die InternalError Logging.die InternalError
"Expected that the current class ptr in the context is a valid pointer to class decl, but didn't find declaration, ptr is %d " "Expected that the current class ptr in the context is a valid pointer to class decl, \
ptr ) but didn't find declaration, ptr is %d " ptr )
| CContext.ContextNoCls -> | CContext.ContextNoCls ->
Logging.die InternalError Logging.die InternalError
"This should only be called in the context of a class, but got CContext.ContextNoCls" "This should only be called in the context of a class, but got CContext.ContextNoCls"
@ -625,13 +625,13 @@ let create_local_procdesc ?(set_objc_accessor_attr= false) trans_unit_ctx cfg te
in in
Cfg.create_proc_desc cfg proc_attributes Cfg.create_proc_desc cfg proc_attributes
in in
if defined then if defined then (
let start_kind = Procdesc.Node.Start_node proc_name in let start_kind = Procdesc.Node.Start_node proc_name in
let start_node = Procdesc.create_node procdesc loc_start start_kind [] in let start_node = Procdesc.create_node procdesc loc_start start_kind [] in
let exit_kind = Procdesc.Node.Exit_node proc_name in let exit_kind = Procdesc.Node.Exit_node proc_name in
let exit_node = Procdesc.create_node procdesc loc_exit exit_kind [] in let exit_node = Procdesc.create_node procdesc loc_exit exit_kind [] in
Procdesc.set_start_node procdesc start_node ; Procdesc.set_start_node procdesc start_node ;
Procdesc.set_exit_node procdesc exit_node Procdesc.set_exit_node procdesc exit_node )
in in
if should_create_procdesc cfg proc_name defined set_objc_accessor_attr then ( if should_create_procdesc cfg proc_name defined set_objc_accessor_attr then (
create_new_procdesc () ; true ) create_new_procdesc () ; true )

@ -450,7 +450,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
{empty_res_trans with exps= [(Exp.Sizeof sizeof_data, sizeof_typ)]} {empty_res_trans with exps= [(Exp.Sizeof sizeof_data, sizeof_typ)]}
| k -> | k ->
L.(debug Capture Medium) L.(debug Capture Medium)
"@\nWARNING: Missing translation of Uniry_Expression_Or_Trait of kind: %s . Expression ignored, returned -1... @\n" "@\n\
WARNING: Missing translation of Uniry_Expression_Or_Trait of kind: %s . Expression \
ignored, returned -1... @\n\
"
(Clang_ast_j.string_of_unary_expr_or_type_trait_kind k) ; (Clang_ast_j.string_of_unary_expr_or_type_trait_kind k) ;
{empty_res_trans with exps= [(Exp.minus_one, typ)]} {empty_res_trans with exps= [(Exp.minus_one, typ)]}
@ -1007,7 +1010,8 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let res_trans_callee = instruction trans_state_callee fun_exp_stmt in let res_trans_callee = instruction trans_state_callee fun_exp_stmt in
let sil_fe, _ = let sil_fe, _ =
extract_exp_from_list res_trans_callee.exps extract_exp_from_list res_trans_callee.exps
"WARNING: The translation of fun_exp did not return an expression.Returning -1. NEED TO BE FIXED" "WARNING: The translation of fun_exp did not return an expression.Returning -1. NEED TO \
BE FIXED"
in in
let callee_pname_opt = let callee_pname_opt =
match sil_fe with Exp.Const Const.Cfun pn -> Some pn | _ -> None match sil_fe with Exp.Const Const.Cfun pn -> Some pn | _ -> None
@ -1042,8 +1046,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
else else
(* FIXME(t21762295) this is reachable *) (* FIXME(t21762295) this is reachable *)
CFrontend_config.incorrect_assumption __POS__ si.Clang_ast_t.si_source_range CFrontend_config.incorrect_assumption __POS__ si.Clang_ast_t.si_source_range
"In call to %a: stmt_list and res_trans_par.exps must have same size but they don't:@\nstmt_list(%d)=[%a]@\nres_trans_par.exps(%d)=[%a]@\n" "In call to %a: stmt_list and res_trans_par.exps must have same size but they don't:@\n\
Typ.Procname.pp procname (List.length params) (Pp.seq Exp.pp) stmt_list(%d)=[%a]@\n\
res_trans_par.exps(%d)=[%a]@\n\
" Typ.Procname.pp procname (List.length params) (Pp.seq Exp.pp)
(List.map ~f:fst params) (List.length params_stmt) (List.map ~f:fst params) (List.length params_stmt)
(Pp.seq (Pp.to_string ~f:Clang_ast_j.string_of_stmt)) (Pp.seq (Pp.to_string ~f:Clang_ast_j.string_of_stmt))
params_stmt params_stmt
@ -2413,7 +2419,9 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in let trans_state_pri = PriorityNode.try_claim_priority_node trans_state stmt_info in
let stmt = let stmt =
extract_stmt_from_singleton stmt_list extract_stmt_from_singleton stmt_list
"WARNING: We expect only one element in stmt list defining the operand in UnaryOperator. NEED FIXING@\n" "WARNING: We expect only one element in stmt list defining the operand in UnaryOperator. \
NEED FIXING@\n\
"
in in
let trans_state' = {trans_state_pri with succ_nodes= []} in let trans_state' = {trans_state_pri with succ_nodes= []} in
let res_trans_stmt = instruction trans_state' stmt in let res_trans_stmt = instruction trans_state' stmt in
@ -2524,7 +2532,10 @@ module CTrans_funct (F : CModule_type.CFrontend) : CModule_type.CTranslation = s
{empty_res_trans with root_nodes= [ret_node]; leaf_nodes= []} {empty_res_trans with root_nodes= [ret_node]; leaf_nodes= []}
| _ -> | _ ->
L.(debug Capture Verbose) L.(debug Capture Verbose)
"@\nWARNING: Missing translation of Return Expression. Return Statement ignored. Need fixing!@\n" ; "@\n\
WARNING: Missing translation of Return Expression. Return Statement ignored. Need \
fixing!@\n\
" ;
{empty_res_trans with root_nodes= succ_nodes} {empty_res_trans with root_nodes= succ_nodes}
in in
(* We expect a return with only one expression *) (* We expect a return with only one expression *)

@ -230,7 +230,7 @@ module PriorityNode = struct
let compute_results_to_parent trans_state loc nd_name stmt_info res_states_children = let compute_results_to_parent trans_state loc nd_name stmt_info res_states_children =
let res_state = collect_res_trans trans_state.context.procdesc res_states_children in let res_state = collect_res_trans trans_state.context.procdesc res_states_children in
let create_node = own_priority_node trans_state.priority stmt_info && res_state.instrs <> [] in let create_node = own_priority_node trans_state.priority stmt_info && res_state.instrs <> [] in
if create_node then if create_node then (
(* We need to create a node *) (* We need to create a node *)
let node_kind = Procdesc.Node.Stmt_node nd_name in let node_kind = Procdesc.Node.Stmt_node nd_name in
let node = Nodes.create_node node_kind res_state.instrs loc trans_state.context in let node = Nodes.create_node node_kind res_state.instrs loc trans_state.context in
@ -240,7 +240,7 @@ module PriorityNode = struct
res_state.leaf_nodes ; res_state.leaf_nodes ;
(* Invariant: if root_nodes is empty then the params have not created a node.*) (* Invariant: if root_nodes is empty then the params have not created a node.*)
let root_nodes = if res_state.root_nodes <> [] then res_state.root_nodes else [node] in let root_nodes = if res_state.root_nodes <> [] then res_state.root_nodes else [node] in
{res_state with root_nodes; leaf_nodes= [node]; instrs= []; exps= []} {res_state with root_nodes; leaf_nodes= [node]; instrs= []; exps= []} )
else else
(* The node is created by the parent. We just pass back nodes/leafs params *) (* The node is created by the parent. We just pass back nodes/leafs params *)
{res_state with exps= []} {res_state with exps= []}

@ -357,7 +357,9 @@ type abs_ctype =
let display_equality_warning () = let display_equality_warning () =
L.(debug Linters Medium) L.(debug Linters Medium)
"[WARNING:] Type Comparison failed... This might indicate that the types are different or the specified type is internally represented in a different way and therefore not recognized.@\n" "[WARNING:] Type Comparison failed... This might indicate that the types are different or the \
specified type is internally represented in a different way and therefore not recognized.@\n\
"
let rec abs_ctype_to_string t = let rec abs_ctype_to_string t =
@ -483,7 +485,11 @@ and check_type_ptr type_ptr abs_ctype =
comparison function for Clang_ast_t.c_type *) comparison function for Clang_ast_t.c_type *)
and c_type_equal c_type abs_ctype = and c_type_equal c_type abs_ctype =
L.(debug Linters Medium) L.(debug Linters Medium)
"@\nComparing c_type/abs_ctype for equality... Type compared: @\nc_type = `%s` @\nabs_ctype =`%s`@\n" "@\n\
Comparing c_type/abs_ctype for equality... Type compared: @\n\
c_type = `%s` @\n\
abs_ctype =`%s`@\n\
"
(Clang_ast_j.string_of_c_type c_type) (Clang_ast_j.string_of_c_type c_type)
(abs_ctype_to_string abs_ctype) ; (abs_ctype_to_string abs_ctype) ;
let open Clang_ast_t in let open Clang_ast_t in

@ -257,8 +257,11 @@ let add_valid_formulae an checker lcxt cl =
add_in_set phi acc_set add_in_set phi acc_set
| AG _ | AX _ | AF _ | AU _ | EH _ | ET _ | Implies _ -> | AG _ | AX _ | AF _ | AU _ | EH _ | ET _ | Implies _ ->
Logging.die InternalError Logging.die InternalError
"@\n We should not have operators AG, AX, AF, AU, EH, ET.\n Failing with formula @\n %a@\n" "@\n \
CTL.Debug.pp_formula phi We should not have operators AG, AX, AF, AU, EH, ET.\n \
Failing with formula @\n \
%a@\n\
" CTL.Debug.pp_formula phi
| _ -> | _ ->
acc_set acc_set
in in
@ -329,11 +332,11 @@ let build_valuation an lcxt linter_map_context =
closure_map := ClosureHashtbl.add normalized_condition (is_state_only, cl') !closure_map ; closure_map := ClosureHashtbl.add normalized_condition (is_state_only, cl') !closure_map ;
(is_state_only, cl') (is_state_only, cl')
in in
if not (is_state_only && skip_evaluation_InNode_formula an normalized_condition) then if not (is_state_only && skip_evaluation_InNode_formula an normalized_condition) then (
let sat_set = add_valid_formulae an linter.issue_desc.id lcxt cl in let sat_set = add_valid_formulae an linter.issue_desc.id lcxt cl in
(*L.progress " [Set Size: %i] @\n" (CTLFormulaSet.cardinal sat_set);*) (*L.progress " [Set Size: %i] @\n" (CTLFormulaSet.cardinal sat_set);*)
if CTLFormulaSet.mem normalized_condition sat_set then report_issue an lcxt linter ; if CTLFormulaSet.mem normalized_condition sat_set then report_issue an lcxt linter ;
add_formula_to_valuation (node_pointer, linter.issue_desc.id) sat_set add_formula_to_valuation (node_pointer, linter.issue_desc.id) sat_set )
in in
List.iter List.iter
~f:(fun (linter: linter) -> ~f:(fun (linter: linter) ->

@ -844,13 +844,13 @@ let get_reporting_explanation_java report_kind tenv pname thread =
| _, Some threadsafe_explanation when RacerDDomain.ThreadsDomain.is_any thread -> | _, Some threadsafe_explanation when RacerDDomain.ThreadsDomain.is_any thread ->
( IssueType.thread_safety_violation ( IssueType.thread_safety_violation
, F.asprintf , F.asprintf
"%s, so we assume that this method can run in parallel with other non-private methods in the class (including itself)." "%s, so we assume that this method can run in parallel with other non-private methods \
threadsafe_explanation ) in the class (including itself)." threadsafe_explanation )
| _, Some threadsafe_explanation -> | _, Some threadsafe_explanation ->
( IssueType.thread_safety_violation ( IssueType.thread_safety_violation
, F.asprintf , F.asprintf
"%s. Although this access is not known to run on a background thread, it may happen in parallel with another access that does." "%s. Although this access is not known to run on a background thread, it may happen in \
threadsafe_explanation ) parallel with another access that does." threadsafe_explanation )
| _, None -> | _, None ->
(* failed to explain based on @ThreadSafe annotation; have to justify using background thread *) (* failed to explain based on @ThreadSafe annotation; have to justify using background thread *)
if RacerDDomain.ThreadsDomain.is_any thread then if RacerDDomain.ThreadsDomain.is_any thread then
@ -859,8 +859,9 @@ let get_reporting_explanation_java report_kind tenv pname thread =
else else
( IssueType.thread_safety_violation ( IssueType.thread_safety_violation
, F.asprintf , F.asprintf
"@\n Reporting because another access to the same memory occurs on a background thread, although this access may not." "@\n \
) Reporting because another access to the same memory occurs on a background thread, \
although this access may not." )
(** Explain why we are reporting this access, in C++ *) (** Explain why we are reporting this access, in C++ *)
@ -995,8 +996,12 @@ let get_contaminated_race_message access wobbly_paths =
in in
Option.map wobbly_path_opt ~f:(fun (wobbly_path, access_path) -> Option.map wobbly_path_opt ~f:(fun (wobbly_path, access_path) ->
F.asprintf F.asprintf
"@\n\nNote that the prefix path %a has been contaminated during the execution, so the reported race on %a might be a false positive.@\n\n" "@\n\
AccessPath.pp wobbly_path AccessPath.pp access_path ) \n\
Note that the prefix path %a has been contaminated during the execution, so the reported \
race on %a might be a false positive.@\n\
\n\
" AccessPath.pp wobbly_path AccessPath.pp access_path )
let report_thread_safety_violation tenv pdesc ~make_description ~report_kind access thread let report_thread_safety_violation tenv pdesc ~make_description ~report_kind access thread
@ -1058,7 +1063,8 @@ let report_unannotated_interface_violation tenv pdesc access thread reported_pna
let class_name = Typ.Procname.Java.get_class_name java_pname in let class_name = Typ.Procname.Java.get_class_name java_pname in
let make_description _ _ _ _ = let make_description _ _ _ _ =
F.asprintf F.asprintf
"Unprotected call to method of un-annotated interface %s. Consider annotating the class with %a, adding a lock, or using an interface that is known to be thread-safe." "Unprotected call to method of un-annotated interface %s. Consider annotating the class \
with %a, adding a lock, or using an interface that is known to be thread-safe."
class_name MF.pp_monospaced "@ThreadSafe" class_name MF.pp_monospaced "@ThreadSafe"
in in
report_thread_safety_violation tenv pdesc ~make_description ~report_kind:UnannotatedInterface report_thread_safety_violation tenv pdesc ~make_description ~report_kind:UnannotatedInterface
@ -1222,12 +1228,12 @@ let report_unsafe_accesses (aggregated_access_map: reported_access list AccessLi
in in
if AccessData.is_unprotected precondition if AccessData.is_unprotected precondition
&& (not (List.is_empty writes_on_background_thread) || ThreadsDomain.is_any threads) && (not (List.is_empty writes_on_background_thread) || ThreadsDomain.is_any threads)
then then (
let conflict = List.hd writes_on_background_thread in let conflict = List.hd writes_on_background_thread in
report_thread_safety_violation tenv procdesc report_thread_safety_violation tenv procdesc
~make_description:make_unprotected_write_description ~make_description:make_unprotected_write_description
~report_kind:(WriteWriteRace conflict) access threads wobbly_paths ; ~report_kind:(WriteWriteRace conflict) access threads wobbly_paths ;
update_reported access pname reported_acc update_reported access pname reported_acc )
else reported_acc else reported_acc
| _ -> | _ ->
(* Do not report unprotected writes when an access can't run in parallel with itself, or (* Do not report unprotected writes when an access can't run in parallel with itself, or
@ -1252,12 +1258,12 @@ let report_unsafe_accesses (aggregated_access_map: reported_access list AccessLi
is_conflict other_access precondition other_threads ) is_conflict other_access precondition other_threads )
accesses accesses
in in
if not (List.is_empty all_writes) then if not (List.is_empty all_writes) then (
let conflict = List.hd_exn all_writes in let conflict = List.hd_exn all_writes in
report_thread_safety_violation tenv procdesc report_thread_safety_violation tenv procdesc
~make_description:(make_read_write_race_description ~read_is_sync:false conflict) ~make_description:(make_read_write_race_description ~read_is_sync:false conflict)
~report_kind:(ReadWriteRace conflict.access) access threads wobbly_paths ; ~report_kind:(ReadWriteRace conflict.access) access threads wobbly_paths ;
update_reported access pname reported_acc update_reported access pname reported_acc )
else reported_acc else reported_acc
| Access.Read _ | ContainerRead _ -> | Access.Read _ | ContainerRead _ ->
(* protected read. report unprotected writes and opposite protected writes as conflicts *) (* protected read. report unprotected writes and opposite protected writes as conflicts *)
@ -1279,13 +1285,13 @@ let report_unsafe_accesses (aggregated_access_map: reported_access list AccessLi
) )
accesses accesses
in in
if not (List.is_empty conflicting_writes) then if not (List.is_empty conflicting_writes) then (
let conflict = List.hd_exn conflicting_writes in let conflict = List.hd_exn conflicting_writes in
(* protected read with conflicting unprotected write(s). warn. *) (* protected read with conflicting unprotected write(s). warn. *)
report_thread_safety_violation tenv procdesc report_thread_safety_violation tenv procdesc
~make_description:(make_read_write_race_description ~read_is_sync:true conflict) ~make_description:(make_read_write_race_description ~read_is_sync:true conflict)
~report_kind:(ReadWriteRace conflict.access) access threads wobbly_paths ; ~report_kind:(ReadWriteRace conflict.access) access threads wobbly_paths ;
update_reported access pname reported_acc update_reported access pname reported_acc )
else reported_acc else reported_acc
in in
AccessListMap.fold AccessListMap.fold

@ -615,16 +615,25 @@ type summary =
let pp_summary fmt {threads; locks; accesses; return_ownership; return_attributes; wobbly_paths} = let pp_summary fmt {threads; locks; accesses; return_ownership; return_attributes; wobbly_paths} =
F.fprintf fmt F.fprintf fmt
"@\nThreads: %a, Locks: %a @\nAccesses %a @\nOwnership: %a @\nReturn Attributes: %a @\nWobbly Paths: %a@\n" "@\n\
ThreadsDomain.pp threads LocksDomain.pp locks AccessDomain.pp accesses Threads: %a, Locks: %a @\n\
Accesses %a @\n\
Ownership: %a @\n\
Return Attributes: %a @\n\
Wobbly Paths: %a@\n\
" ThreadsDomain.pp threads LocksDomain.pp locks AccessDomain.pp accesses
OwnershipAbstractValue.pp return_ownership AttributeSetDomain.pp return_attributes OwnershipAbstractValue.pp return_ownership AttributeSetDomain.pp return_attributes
StabilityDomain.pp wobbly_paths StabilityDomain.pp wobbly_paths
let pp fmt {threads; locks; accesses; ownership; attribute_map; wobbly_paths} = let pp fmt {threads; locks; accesses; ownership; attribute_map; wobbly_paths} =
F.fprintf fmt F.fprintf fmt
"Threads: %a, Locks: %a @\nAccesses %a @\n Ownership: %a @\nAttributes: %a @\nNon-stable Paths: %a@\n" "Threads: %a, Locks: %a @\n\
ThreadsDomain.pp threads LocksDomain.pp locks AccessDomain.pp accesses OwnershipDomain.pp Accesses %a @\n \
Ownership: %a @\n\
Attributes: %a @\n\
Non-stable Paths: %a@\n\
" ThreadsDomain.pp threads LocksDomain.pp locks AccessDomain.pp accesses OwnershipDomain.pp
ownership AttributeMapDomain.pp attribute_map StabilityDomain.pp wobbly_paths ownership AttributeMapDomain.pp attribute_map StabilityDomain.pp wobbly_paths

@ -111,13 +111,14 @@ module MkCallback (Extension : ExtensionT) : CallBackT = struct
curr_pname curr_pdesc find_canonical_duplicate annotated_signature typestate node curr_pname curr_pdesc find_canonical_duplicate annotated_signature typestate node
linereader linereader
in in
( if Config.write_html then if Config.write_html then (
let d_typestate ts = L.d_strln (F.asprintf "%a" (TypeState.pp Extension.ext) ts) in let d_typestate ts = L.d_strln (F.asprintf "%a" (TypeState.pp Extension.ext) ts) in
L.d_strln "before:" ; L.d_strln "before:" ;
d_typestate typestate ; d_typestate typestate ;
L.d_strln "after:" ; L.d_strln "after:" ;
List.iter ~f:d_typestate typestates_succ ) ; List.iter ~f:d_typestate typestates_succ ) ;
NodePrinter.finish_session node ; (typestates_succ, typestates_exn) NodePrinter.finish_session node ;
(typestates_succ, typestates_exn)
let proc_throws _ = DontKnow let proc_throws _ = DontKnow

@ -209,15 +209,15 @@ let check_field_assignment tenv find_canonical_duplicate curr_pdesc node instr_r
true ) true )
&& not (field_is_mutable ()) && not (field_is_mutable ())
in in
( if should_report_nullable || should_report_absent then if should_report_nullable || should_report_absent then (
let ann = let ann =
if should_report_nullable then AnnotatedSignature.Nullable else AnnotatedSignature.Present if should_report_nullable then AnnotatedSignature.Nullable else AnnotatedSignature.Present
in in
if Models.Inference.enabled then Models.Inference.field_add_nullable_annotation fname ; if Models.Inference.enabled then Models.Inference.field_add_nullable_annotation fname ;
let origin_descr = TypeAnnotation.descr_origin tenv ta_rhs in let origin_descr = TypeAnnotation.descr_origin tenv ta_rhs in
report_error tenv find_canonical_duplicate report_error tenv find_canonical_duplicate
(TypeErr.Field_annotation_inconsistent (ann, fname, origin_descr)) (Some instr_ref) loc (TypeErr.Field_annotation_inconsistent (ann, fname, origin_descr)) (Some instr_ref) loc
curr_pdesc ) ; curr_pdesc ) ;
if should_report_mutable then if should_report_mutable then
let origin_descr = TypeAnnotation.descr_origin tenv ta_rhs in let origin_descr = TypeAnnotation.descr_origin tenv ta_rhs in
report_error tenv find_canonical_duplicate (TypeErr.Field_not_mutable (fname, origin_descr)) report_error tenv find_canonical_duplicate (TypeErr.Field_not_mutable (fname, origin_descr))

@ -295,29 +295,30 @@ let annotated_list_nullable =
, "javax.lang.model.util.Elements.getAllAnnotationMirrors(javax.lang.model.element.Element):java.util.List" , "javax.lang.model.util.Elements.getAllAnnotationMirrors(javax.lang.model.element.Element):java.util.List"
) )
; ( o2 ; ( o2
, "javax.lang.model.util.Elements.hides(javax.lang.model.element.Element, javax.lang.model.element.Element):boolean" , "javax.lang.model.util.Elements.hides(javax.lang.model.element.Element, \
) javax.lang.model.element.Element):boolean" )
; ( o3 ; ( o3
, "javax.lang.model.util.Elements.overrides(javax.lang.model.element.ExecutableElement, javax.lang.model.element.ExecutableElement, javax.lang.model.element.TypeElement):boolean" , "javax.lang.model.util.Elements.overrides(javax.lang.model.element.ExecutableElement, \
javax.lang.model.element.ExecutableElement, javax.lang.model.element.TypeElement):boolean"
) )
; ( o1 ; ( o1
, "javax.lang.model.util.Types.asElement(javax.lang.model.type.TypeMirror):javax.lang.model.element.Element" , "javax.lang.model.util.Types.asElement(javax.lang.model.type.TypeMirror):javax.lang.model.element.Element"
) )
; ( o2 ; ( o2
, "javax.lang.model.util.Types.isSameType(javax.lang.model.type.TypeMirror, javax.lang.model.type.TypeMirror):boolean" , "javax.lang.model.util.Types.isSameType(javax.lang.model.type.TypeMirror, \
) javax.lang.model.type.TypeMirror):boolean" )
; ( o2 ; ( o2
, "javax.lang.model.util.Types.isSubtype(javax.lang.model.type.TypeMirror, javax.lang.model.type.TypeMirror):boolean" , "javax.lang.model.util.Types.isSubtype(javax.lang.model.type.TypeMirror, \
) javax.lang.model.type.TypeMirror):boolean" )
; ( o2 ; ( o2
, "javax.lang.model.util.Types.isAssignable(javax.lang.model.type.TypeMirror, javax.lang.model.type.TypeMirror):boolean" , "javax.lang.model.util.Types.isAssignable(javax.lang.model.type.TypeMirror, \
) javax.lang.model.type.TypeMirror):boolean" )
; ( o2 ; ( o2
, "javax.lang.model.util.Types.contains(javax.lang.model.type.TypeMirror, javax.lang.model.type.TypeMirror):boolean" , "javax.lang.model.util.Types.contains(javax.lang.model.type.TypeMirror, \
) javax.lang.model.type.TypeMirror):boolean" )
; ( o2 ; ( o2
, "javax.lang.model.util.Types.isSubsignature(javax.lang.model.type.ExecutableType, javax.lang.model.type.ExecutableType):boolean" , "javax.lang.model.util.Types.isSubsignature(javax.lang.model.type.ExecutableType, \
) javax.lang.model.type.ExecutableType):boolean" )
; ( o1 ; ( o1
, "javax.lang.model.util.Types.directSupertypes(javax.lang.model.type.TypeMirror):java.util.List" , "javax.lang.model.util.Types.directSupertypes(javax.lang.model.type.TypeMirror):java.util.List"
) )
@ -337,34 +338,35 @@ let annotated_list_nullable =
, "javax.lang.model.util.Types.getArrayType(javax.lang.model.type.TypeMirror):javax.lang.model.type.ArrayType" , "javax.lang.model.util.Types.getArrayType(javax.lang.model.type.TypeMirror):javax.lang.model.type.ArrayType"
) )
; ( o2 ; ( o2
, "javax.lang.model.util.Types.getWildcardType(javax.lang.model.type.TypeMirror, javax.lang.model.type.TypeMirror):javax.lang.model.type.WildcardType" , "javax.lang.model.util.Types.getWildcardType(javax.lang.model.type.TypeMirror, \
) javax.lang.model.type.TypeMirror):javax.lang.model.type.WildcardType" )
; ( o2 ; ( o2
, "javax.lang.model.util.Types.getDeclaredType(javax.lang.model.element.TypeElement, javax.lang.model.type.TypeMirror[]):javax.lang.model.type.DeclaredType" , "javax.lang.model.util.Types.getDeclaredType(javax.lang.model.element.TypeElement, \
) javax.lang.model.type.TypeMirror[]):javax.lang.model.type.DeclaredType" )
; ( o3 ; ( o3
, "javax.lang.model.util.Types.getDeclaredType(javax.lang.model.type.DeclaredType, javax.lang.model.element.TypeElement, javax.lang.model.type.TypeMirror[]):javax.lang.model.type.DeclaredType" , "javax.lang.model.util.Types.getDeclaredType(javax.lang.model.type.DeclaredType, \
) javax.lang.model.element.TypeElement, \
javax.lang.model.type.TypeMirror[]):javax.lang.model.type.DeclaredType" )
; ( o2 ; ( o2
, "javax.lang.model.util.Types.asMemberOf(javax.lang.model.type.DeclaredType, javax.lang.model.element.Element):javax.lang.model.type.TypeMirror" , "javax.lang.model.util.Types.asMemberOf(javax.lang.model.type.DeclaredType, \
) javax.lang.model.element.Element):javax.lang.model.type.TypeMirror" )
; ( n3 ; ( n3
, "javax.tools.JavaCompiler.getStandardFileManager(javax.tools.DiagnosticListener,java.util.Locale,java.nio.charset.Charset):javax.tools.StandardJavaFileManager" , "javax.tools.JavaCompiler.getStandardFileManager(javax.tools.DiagnosticListener,java.util.Locale,java.nio.charset.Charset):javax.tools.StandardJavaFileManager"
) )
; (ng, "javax.tools.JavaFileObject.getAccessLevel():javax.lang.model.element.Modifier") ; (ng, "javax.tools.JavaFileObject.getAccessLevel():javax.lang.model.element.Modifier")
; (ng, "javax.tools.JavaFileObject.getNestingKind():javax.lang.model.element.NestingKind") ; (ng, "javax.tools.JavaFileObject.getNestingKind():javax.lang.model.element.NestingKind")
; ( o2 ; ( o2
, "com.sun.source.util.SourcePositions.getStartPosition(com.sun.source.tree.CompilationUnitTree, com.sun.source.tree.Tree):long" , "com.sun.source.util.SourcePositions.getStartPosition(com.sun.source.tree.CompilationUnitTree, \
) com.sun.source.tree.Tree):long" )
; ( o2 ; ( o2
, "com.sun.source.util.SourcePositions.getEndPosition(com.sun.source.tree.CompilationUnitTree, com.sun.source.tree.Tree):long" , "com.sun.source.util.SourcePositions.getEndPosition(com.sun.source.tree.CompilationUnitTree, \
) com.sun.source.tree.Tree):long" )
; ( (n, [o; o]) ; ( (n, [o; o])
, "com.sun.source.util.TreePath.getPath(com.sun.source.tree.CompilationUnitTree, com.sun.source.tree.Tree):com.sun.source.util.TreePath" , "com.sun.source.util.TreePath.getPath(com.sun.source.tree.CompilationUnitTree, \
) com.sun.source.tree.Tree):com.sun.source.util.TreePath" )
; ( (n, [o; o]) ; ( (n, [o; o])
, "com.sun.source.util.TreePath.getPath(com.sun.source.util.TreePath, com.sun.source.tree.Tree):com.sun.source.util.TreePath" , "com.sun.source.util.TreePath.getPath(com.sun.source.util.TreePath, \
) com.sun.source.tree.Tree):com.sun.source.util.TreePath" )
; ( (n, [o]) ; ( (n, [o])
, "com.sun.source.util.Trees.getTree(javax.lang.model.element.Element):com.sun.source.tree.Tree" , "com.sun.source.util.Trees.getTree(javax.lang.model.element.Element):com.sun.source.tree.Tree"
) )
@ -375,23 +377,25 @@ let annotated_list_nullable =
, "com.sun.source.util.Trees.getTree(javax.lang.model.element.ExecutableElement):com.sun.source.tree.MethodTree" , "com.sun.source.util.Trees.getTree(javax.lang.model.element.ExecutableElement):com.sun.source.tree.MethodTree"
) )
; ( (n, [o; o]) ; ( (n, [o; o])
, "com.sun.source.util.Trees.getTree(javax.lang.model.element.Element, javax.lang.model.element.AnnotationMirror):com.sun.source.tree.Tree" , "com.sun.source.util.Trees.getTree(javax.lang.model.element.Element, \
) javax.lang.model.element.AnnotationMirror):com.sun.source.tree.Tree" )
; ( (n, [o; o; o]) ; ( (n, [o; o; o])
, "com.sun.source.util.Trees.getTree(javax.lang.model.element.Element, javax.lang.model.element.AnnotationMirror, javax.lang.model.element.AnnotationValue):com.sun.source.tree.Tree" , "com.sun.source.util.Trees.getTree(javax.lang.model.element.Element, \
) javax.lang.model.element.AnnotationMirror, \
javax.lang.model.element.AnnotationValue):com.sun.source.tree.Tree" )
; ( o2 ; ( o2
, "com.sun.source.util.Trees.getPath(com.sun.source.tree.CompilationUnitTree, com.sun.source.tree.Tree):com.sun.source.util.TreePath" , "com.sun.source.util.Trees.getPath(com.sun.source.tree.CompilationUnitTree, \
) com.sun.source.tree.Tree):com.sun.source.util.TreePath" )
; ( (n, [o]) ; ( (n, [o])
, "com.sun.source.util.Trees.getPath(javax.lang.model.element.Element):com.sun.source.util.TreePath" , "com.sun.source.util.Trees.getPath(javax.lang.model.element.Element):com.sun.source.util.TreePath"
) )
; ( (n, [o; o]) ; ( (n, [o; o])
, "com.sun.source.util.Trees.getPath(javax.lang.model.element.Element, javax.lang.model.element.AnnotationMirror):com.sun.source.util.TreePath" , "com.sun.source.util.Trees.getPath(javax.lang.model.element.Element, \
) javax.lang.model.element.AnnotationMirror):com.sun.source.util.TreePath" )
; ( (n, [o; o; o]) ; ( (n, [o; o; o])
, "com.sun.source.util.Trees.getPath(javax.lang.model.element.Element, javax.lang.model.element.AnnotationMirror, javax.lang.model.element.AnnotationValue):com.sun.source.util.TreePath" , "com.sun.source.util.Trees.getPath(javax.lang.model.element.Element, \
) javax.lang.model.element.AnnotationMirror, \
javax.lang.model.element.AnnotationValue):com.sun.source.util.TreePath" )
; ( (n, [o]) ; ( (n, [o])
, "com.sun.source.util.Trees.getElement(com.sun.source.util.TreePath):javax.lang.model.element.Element" , "com.sun.source.util.Trees.getElement(com.sun.source.util.TreePath):javax.lang.model.element.Element"
) )
@ -404,17 +408,18 @@ let annotated_list_nullable =
; ( (n, [o]) ; ( (n, [o])
, "com.sun.source.util.Trees.getDocComment(com.sun.source.util.TreePath):java.lang.String" ) , "com.sun.source.util.Trees.getDocComment(com.sun.source.util.TreePath):java.lang.String" )
; ( o2 ; ( o2
, "com.sun.source.util.Trees.isAccessible(com.sun.source.tree.Scope, javax.lang.model.element.TypeElement):boolean" , "com.sun.source.util.Trees.isAccessible(com.sun.source.tree.Scope, \
) javax.lang.model.element.TypeElement):boolean" )
; ( o3 ; ( o3
, "com.sun.source.util.Trees.isAccessible(com.sun.source.tree.Scope, javax.lang.model.element.Element, javax.lang.model.type.DeclaredType):boolean" , "com.sun.source.util.Trees.isAccessible(com.sun.source.tree.Scope, \
) javax.lang.model.element.Element, javax.lang.model.type.DeclaredType):boolean" )
; ( o1 ; ( o1
, "com.sun.source.util.Trees.getOriginalType(javax.lang.model.type.ErrorType):javax.lang.model.type.TypeMirror" , "com.sun.source.util.Trees.getOriginalType(javax.lang.model.type.ErrorType):javax.lang.model.type.TypeMirror"
) )
; ( (o, [o; o; o; o]) ; ( (o, [o; o; o; o])
, "com.sun.source.util.Trees.printMessage(javax.tools.Diagnostic.Kind, java.lang.CharSequence, com.sun.source.tree.Tree, com.sun.source.tree.CompilationUnitTree):void" , "com.sun.source.util.Trees.printMessage(javax.tools.Diagnostic.Kind, \
) java.lang.CharSequence, com.sun.source.tree.Tree, \
com.sun.source.tree.CompilationUnitTree):void" )
; ( o1 ; ( o1
, "com.sun.source.util.Trees.getLub(com.sun.source.tree.CatchTree):javax.lang.model.type.TypeMirror" , "com.sun.source.util.Trees.getLub(com.sun.source.tree.CatchTree):javax.lang.model.type.TypeMirror"
) )

@ -447,8 +447,8 @@ let report_error_now tenv (st_report_error: st_report_error) err_instance loc pd
in in
( IssueType.eradicate_inconsistent_subclass_parameter_annotation ( IssueType.eradicate_inconsistent_subclass_parameter_annotation
, Format.asprintf , Format.asprintf
"%s parameter %a of method %a is not %a but is declared %ain the parent class method %a." "%s parameter %a of method %a is not %a but is declared %ain the parent class method \
(translate_position pos) MF.pp_monospaced param_name MF.pp_monospaced %a." (translate_position pos) MF.pp_monospaced param_name MF.pp_monospaced
(Typ.Procname.to_simplified_string ~withclass:true pn) (Typ.Procname.to_simplified_string ~withclass:true pn)
MF.pp_monospaced "@Nullable" MF.pp_monospaced "@Nullable" MF.pp_monospaced MF.pp_monospaced "@Nullable" MF.pp_monospaced "@Nullable" MF.pp_monospaced
(Typ.Procname.to_simplified_string ~withclass:true opn) (Typ.Procname.to_simplified_string ~withclass:true opn)

@ -258,12 +258,12 @@ let rec exceed_length ~max = function
let store_args_in_file args = let store_args_in_file args =
if exceed_length ~max:max_command_line_length args then if exceed_length ~max:max_command_line_length args then (
let file = Filename.temp_file "buck_targets_" ".txt" in let file = Filename.temp_file "buck_targets_" ".txt" in
let write_args outc = Out_channel.output_string outc (String.concat ~sep:"\n" args) in let write_args outc = Out_channel.output_string outc (String.concat ~sep:"\n" args) in
let () = Utils.with_file_out file ~f:write_args in let () = Utils.with_file_out file ~f:write_args in
L.(debug Capture Quiet) "Buck targets options stored in file '%s'@\n" file ; L.(debug Capture Quiet) "Buck targets options stored in file '%s'@\n" file ;
[Printf.sprintf "@%s" file] [Printf.sprintf "@%s" file] )
else args else args

@ -84,7 +84,8 @@ let run_compilation_database compilation_database should_capture_file =
L.(debug Analysis Medium) "Ran %d jobs" number_of_jobs ; L.(debug Analysis Medium) "Ran %d jobs" number_of_jobs ;
if sentinel_exists fail_sentinel then ( if sentinel_exists fail_sentinel then (
L.progress L.progress
"Failure detected, capture did not finish successfully. Use `--linters-ignore-clang-failures` to ignore compilation errors. Terminating@." ; "Failure detected, capture did not finish successfully. Use \
`--linters-ignore-clang-failures` to ignore compilation errors. Terminating@." ;
L.exit 1 ) L.exit 1 )

@ -27,8 +27,8 @@ let checkout revision =
match script_opt with match script_opt with
| None -> | None ->
L.(die UserError) L.(die UserError)
"Please specify a script to checkout the %a revision of your project using --checkout-%a <script>." "Please specify a script to checkout the %a revision of your project using --checkout-%a \
pp_revision revision pp_revision revision <script>." pp_revision revision pp_revision revision
| Some script -> | Some script ->
L.progress "Checking out %a version:@\n %s@\n" pp_revision revision script ; L.progress "Checking out %a version:@\n %s@\n" pp_revision revision script ;
let (), exit_or_signal = Utils.with_process_in script Utils.consume_in in let (), exit_or_signal = Utils.with_process_in script Utils.consume_in in

@ -170,7 +170,10 @@ let check_xcpretty () =
() ()
| Error _ -> | Error _ ->
L.user_error L.user_error
"@\nxcpretty not found in the path. Please consider installing xcpretty for a more robust integration with xcodebuild. Otherwise use the option --no-xcpretty.@\n@." "@\n\
xcpretty not found in the path. Please consider installing xcpretty for a more robust \
integration with xcodebuild. Otherwise use the option --no-xcpretty.@\n\
@."
let capture_with_compilation_database db_files = let capture_with_compilation_database db_files =
@ -258,7 +261,7 @@ let capture ~changed_files mode =
["--xcode-developer-dir"; d] ) ["--xcode-developer-dir"; d] )
@ "--" @ "--"
:: ::
( if in_buck_mode && Config.flavors then ( if in_buck_mode && Config.flavors then (
(* let children infer processes know that they are inside Buck *) (* let children infer processes know that they are inside Buck *)
let infer_args_with_buck = let infer_args_with_buck =
String.concat String.concat
@ -275,7 +278,7 @@ let capture ~changed_files mode =
let updated_buck_cmd = prog :: command :: Buck.store_args_in_file all_args in let updated_buck_cmd = prog :: command :: Buck.store_args_in_file all_args in
Logging.(debug Capture Quiet) Logging.(debug Capture Quiet)
"Processed buck command '%a'@\n" (Pp.seq Pp.string) updated_buck_cmd ; "Processed buck command '%a'@\n" (Pp.seq Pp.string) updated_buck_cmd ;
updated_buck_cmd updated_buck_cmd )
else build_cmd ) ) else build_cmd ) )
in in
run_command ~prog:infer_py ~args run_command ~prog:infer_py ~args
@ -439,7 +442,8 @@ let assert_supported_mode required_analyzer requested_mode_string =
"clang and xcode" "clang and xcode"
in in
L.(die UserError) L.(die UserError)
"Unsupported build mode: %s@\nInfer was built with %s analyzers disabled.@ Please rebuild infer with %s enabled.@." "Unsupported build mode: %s@\n\
Infer was built with %s analyzers disabled.@ Please rebuild infer with %s enabled.@."
requested_mode_string analyzer_string analyzer_string requested_mode_string analyzer_string analyzer_string
@ -461,7 +465,8 @@ let assert_supported_build_system build_system =
else ( else (
if Config.reactive_mode then if Config.reactive_mode then
L.user_error L.user_error
"WARNING: The reactive analysis mode is not compatible with the Buck integration for Java" ; "WARNING: The reactive analysis mode is not compatible with the Buck integration \
for Java" ;
(`Java, Config.string_of_build_system build_system) ) (`Java, Config.string_of_build_system build_system) )
in in
assert_supported_mode analyzer build_string assert_supported_mode analyzer build_string
@ -488,7 +493,8 @@ let mode_of_build_command build_cmd =
match (build_system : Config.build_system) with match (build_system : Config.build_system) with
| BAnalyze -> | BAnalyze ->
CLOpt.warnf CLOpt.warnf
"WARNING: `infer -- analyze` is deprecated; use the `infer analyze` subcommand instead@." ; "WARNING: `infer -- analyze` is deprecated; use the `infer analyze` subcommand \
instead@." ;
Analyze Analyze
| BBuck when Option.is_some Config.buck_compilation_database -> | BBuck when Option.is_some Config.buck_compilation_database ->
BuckCompilationDB (prog, List.append args (List.rev Config.buck_build_args)) BuckCompilationDB (prog, List.append args (List.rev Config.buck_build_args))
@ -543,12 +549,12 @@ let run_prologue mode =
let run_epilogue mode = let run_epilogue mode =
( if CLOpt.is_originator then if CLOpt.is_originator then (
let in_buck_mode = match mode with PythonCapture (BBuck, _) -> true | _ -> false in let in_buck_mode = match mode with PythonCapture (BBuck, _) -> true | _ -> false in
if Config.developer_mode then StatsAggregator.generate_files () ; if Config.developer_mode then StatsAggregator.generate_files () ;
if Config.equal_analyzer Config.analyzer Config.Crashcontext then if Config.equal_analyzer Config.analyzer Config.Crashcontext then
Crashcontext.crashcontext_epilogue ~in_buck_mode ; Crashcontext.crashcontext_epilogue ~in_buck_mode ;
if Config.fail_on_bug then fail_on_issue_epilogue () ) ; if Config.fail_on_bug then fail_on_issue_epilogue () ) ;
if Config.buck_cache_mode then clean_results_dir () ; if Config.buck_cache_mode then clean_results_dir () ;
() ()

@ -61,7 +61,12 @@ let compile compiler build_prog build_args =
| None -> | None ->
let verbose_errlog = Utils.with_file_in verbose_out_file ~f:In_channel.input_all in let verbose_errlog = Utils.with_file_in verbose_out_file ~f:In_channel.input_all in
L.(die UserError) L.(die UserError)
"@\n*** Failed to execute compilation command: %s@\n*** Command: %s@\n*** Output:@\n%s%s@\n*** Infer needs a working compilation command to run.@." "@\n\
*** Failed to execute compilation command: %s@\n\
*** Command: %s@\n\
*** Output:@\n\
%s%s@\n\
*** Infer needs a working compilation command to run.@."
(Unix.Exit_or_signal.to_string_hum (Error err)) (Unix.Exit_or_signal.to_string_hum (Error err))
shell_cmd log verbose_errlog ) shell_cmd log verbose_errlog )
| exception exn -> | exception exn ->

@ -119,7 +119,8 @@ let load_from_verbose_output javac_verbose_out =
1. [wrote DirectoryFileObject[/path/to/classes_out:path/to/File.java]], leaves `path/to/File.java` in match group 2 1. [wrote DirectoryFileObject[/path/to/classes_out:path/to/File.java]], leaves `path/to/File.java` in match group 2
2. [wrote RegularFileObject[path/to/File.java]], leaves `path/to/File.java` in match group 5 2. [wrote RegularFileObject[path/to/File.java]], leaves `path/to/File.java` in match group 5
3. [wrote SimpleFileObject[path/to/File.java]], also leaves `path/to/File.java` in match group 5 *) 3. [wrote SimpleFileObject[path/to/File.java]], also leaves `path/to/File.java` in match group 5 *)
"\\[wrote \\(DirectoryFileObject\\[%s:\\(.*\\)\\|\\(\\(Regular\\|Simple\\)FileObject\\[\\(.*\\)\\)\\)\\]\\]" "\\[wrote \
\\(DirectoryFileObject\\[%s:\\(.*\\)\\|\\(\\(Regular\\|Simple\\)FileObject\\[\\(.*\\)\\)\\)\\]\\]"
Config.javac_classes_out) Config.javac_classes_out)
in in
let source_filename_re = let source_filename_re =

@ -747,8 +747,8 @@ module Make (TaintSpecification : TaintSpec.S) = struct
(* invariant 1: sinks with no footprint sources are dead and should be forgotten *) (* invariant 1: sinks with no footprint sources are dead and should be forgotten *)
if Sources.Footprint.is_empty footprint_sources && not (Sinks.is_empty sinks) then if Sources.Footprint.is_empty footprint_sources && not (Sinks.is_empty sinks) then
Logging.die InternalError Logging.die InternalError
"Trace %a associated with %a tracks sinks even though no more sources can flow into them" "Trace %a associated with %a tracks sinks even though no more sources can flow into \
Sinks.pp sinks AccessPath.Abs.pp access_path ; them" Sinks.pp sinks AccessPath.Abs.pp access_path ;
(* invariant 2: we should never have sinks without sources *) (* invariant 2: we should never have sinks without sources *)
if Sources.is_empty sources && not (Sinks.is_empty sinks) then if Sources.is_empty sources && not (Sinks.is_empty sinks) then
Logging.die InternalError "We have sinks %a associated with %a, but no sources" Sinks.pp Logging.die InternalError "We have sinks %a associated with %a, but no sources" Sinks.pp

@ -251,13 +251,13 @@ let check_copyright fname =
let lines_arr = Array.of_list lines in let lines_arr = Array.of_list lines in
match find_copyright_line lines 0 with match find_copyright_line lines 0 with
| None -> | None ->
if file_should_have_copyright fname then if file_should_have_copyright fname then (
let year = 1900 + (Unix.localtime (Unix.time ())).Unix.tm_year in let year = 1900 + (Unix.localtime (Unix.time ())).Unix.tm_year in
let com_style = List.Assoc.find_exn com_style_of_lang ~equal:Filename.check_suffix fname in let com_style = List.Assoc.find_exn com_style_of_lang ~equal:Filename.check_suffix fname in
let prefix = prefix_of_comment_style com_style in let prefix = prefix_of_comment_style com_style in
let start = default_start_line_of_com_style com_style in let start = default_start_line_of_com_style com_style in
output_diff fname lines_arr start (-1) (-1) 0 false year com_style prefix ; output_diff fname lines_arr start (-1) (-1) 0 false year com_style prefix ;
Pervasives.exit copyright_modified_exit_code Pervasives.exit copyright_modified_exit_code )
| Some n -> | Some n ->
let line = lines_arr.(n) in let line = lines_arr.(n) in
let cstart, com_style = find_comment_start_and_style lines_arr n in let cstart, com_style = find_comment_start_and_style lines_arr n in
@ -270,10 +270,10 @@ let check_copyright fname =
Pervasives.exit copyright_malformed_exit_code Pervasives.exit copyright_malformed_exit_code
| Some fb_year -> | Some fb_year ->
let prefix = prefix_of_comment_style com_style in let prefix = prefix_of_comment_style com_style in
if copyright_has_changed mono fb_year com_style prefix cstart cend lines_arr then if copyright_has_changed mono fb_year com_style prefix cstart cend lines_arr then (
let len = String.length line in let len = String.length line in
output_diff fname lines_arr cstart n cend len mono fb_year com_style prefix ; output_diff fname lines_arr cstart n cend len mono fb_year com_style prefix ;
Pervasives.exit copyright_modified_exit_code ) Pervasives.exit copyright_modified_exit_code ) )
else ( else (
F.eprintf "Copyright not recognized: %s@." fname ; F.eprintf "Copyright not recognized: %s@." fname ;
Pervasives.exit copyright_malformed_exit_code ) Pervasives.exit copyright_malformed_exit_code )

@ -140,8 +140,9 @@ let tests =
; read_field_to_id "read_id" "base_id" "f" ; read_field_to_id "read_id" "base_id" "f"
; var_assign_id "var" "read_id" ; var_assign_id "var" "read_id"
; invariant ; invariant
"{ base_id$0.f* => (SOURCE -> ?),\n ret_id$0* => (SOURCE -> ?),\n &var* => (SOURCE -> ?) }" "{ base_id$0.f* => (SOURCE -> ?),\n \
] ) ret_id$0* => (SOURCE -> ?),\n \
&var* => (SOURCE -> ?) }" ] )
; ( "source flows to var then cleared" ; ( "source flows to var then cleared"
, [ assign_to_source "ret_id" , [ assign_to_source "ret_id"
; var_assign_id "var" "ret_id" ; var_assign_id "var" "ret_id"

Loading…
Cancel
Save