[ocamlformat] Upgrade base and ocamlformat

Summary:
Upgrade ocamlformat to 0.3, and (necessarily) base to v0.10.0.

- Fix accumulated mis-formatting
- Update opam.lock to unbreak clean build
- Update to base v0.10.0
- Update opam.lock for base
- Update offline opam repo
- Everyone should already have removed their ocamlformat pin
- ocamlformat 0.3 supports output to stdout natively
- bump version of ocamlformat

Reviewed By: jeremydubreil

Differential Revision: D6636741

fbshipit-source-id: 41a56a8
master
Josh Berdine 7 years ago committed by Facebook Github Bot
parent 7032bca1d5
commit 63439ecc02

@ -1,3 +1,3 @@
margin 100
sparse true
version v0.2
version 0.3

@ -600,7 +600,6 @@ endif
devsetup: Makefile.autoconf
$(QUIET)[ $(OPAM) != "no" ] || (echo 'No `opam` found, aborting setup.' >&2; exit 1)
$(QUIET)$(call silent_on_success,installing $(OPAM_DEV_DEPS),\
OPAMSWITCH=$(OPAMSWITCH); $(OPAM) pin remove --yes ocamlformat; \
OPAMSWITCH=$(OPAMSWITCH); $(OPAM) install --yes --no-checksum user-setup $(OPAM_DEV_DEPS))
$(QUIET)echo '$(TERM_INFO)*** Running `opam config setup -a`$(TERM_RESET)' >&2
$(QUIET)OPAMSWITCH=$(OPAMSWITCH); $(OPAM) config --yes setup -a

@ -202,7 +202,6 @@ module Raw = struct
let is_prefix ((base1, path1) as ap1) ((base2, path2) as ap2) =
if phys_equal ap1 ap2 then true else equal_base base1 base2 && is_prefix_path path1 path2
end
module Abs = struct
@ -256,7 +255,6 @@ module Abs = struct
Raw.pp fmt access_path
| Abstracted access_path ->
F.fprintf fmt "%a*" Raw.pp access_path
end
include Raw

@ -132,4 +132,3 @@ let find_file_capturing_procedure pname =
`Source
in
(source_file, origin) )

@ -37,4 +37,3 @@ let default =
; cf_is_objc_block= false
; cf_with_block_parameters= false
; cf_targets= [] }

@ -631,4 +631,3 @@ let pp_proc_signatures fmt cfg =
let exists_for_source_file source =
(* simplistic implementation that allocates the cfg as this is only used for reactive capture for now *)
load source |> Option.is_some

@ -337,4 +337,3 @@ let save_call_graph_dotty source (g: t) =
let outc = Out_channel.create (DB.filename_to_string fname_dot) in
let fmt = F.formatter_of_out_channel outc in
pp_graph_dotty g fmt ; Out_channel.close outc

@ -70,4 +70,3 @@ let isminusone_int_float = function
true
| _ ->
false

@ -137,4 +137,3 @@ let rec has_tmp_var = function
has_tmp_var dexp || List.exists ~f:has_tmp_var dexp_list
| Dconst _ | Dunknown | Dsizeof (_, None, _) ->
false

@ -65,7 +65,7 @@ let compute_local_exception_line loc_trace =
snd (List_.fold_until ~init:(`Continue (None, None)) ~f:compute_local_exception_line loc_trace)
type node_id_key = {node_id: int; node_key: Digest.t}
type node_id_key = {node_id: int; node_key: Caml.Digest.t}
type err_key =
{ err_kind: Exceptions.err_kind
@ -113,7 +113,6 @@ module ErrLogHash = struct
(key1.err_kind, key1.in_footprint, key1.err_name)
(key2.err_kind, key2.in_footprint, key2.err_name)
&& Localise.error_desc_equal key1.err_desc key2.err_desc
end
include Hashtbl.Make (Key)
@ -147,12 +146,14 @@ let fold (f: err_key -> err_data -> 'a -> 'a) t acc =
(fun err_key set acc -> ErrDataSet.fold (fun err_data acc -> f err_key err_data acc) set acc)
t acc
(** Return the number of elements in the error log which satisfy [filter] *)
let size filter (err_log: t) =
let count = ref 0 in
ErrLogHash.iter
(fun key err_datas ->
if filter key.err_kind key.in_footprint then count := !count + ErrDataSet.cardinal err_datas)
if filter key.err_kind key.in_footprint then count := !count + ErrDataSet.cardinal err_datas
)
err_log ;
!count
@ -324,7 +325,7 @@ module Err_table = struct
let count_err (err_name: IssueType.t) n =
let err_string = err_name.IssueType.unique_id in
let count = try String.Map.find_exn !err_name_map err_string with Not_found -> 0 in
err_name_map := String.Map.add ~key:err_string ~data:(count + n) !err_name_map
err_name_map := String.Map.set ~key:err_string ~data:(count + n) !err_name_map
in
let count key err_datas =
if Exceptions.equal_err_kind ekind key.err_kind && key.in_footprint then
@ -397,7 +398,6 @@ module Err_table = struct
LocMap.iter
(fun nslm err_names -> F.fprintf fmt "%a" (pp Exceptions.Kwarning nslm) err_names)
!map_warn_re
end
type err_table = Err_table.t

@ -36,7 +36,7 @@ val compute_local_exception_line : loc_trace -> int option
This extra information adds value to the report itself, and may avoid
digging into the trace to understand the cause of the report. *)
type node_id_key = private {node_id: int; node_key: Digest.t}
type node_id_key = private {node_id: int; node_key: Caml.Digest.t}
type err_key = private
{ err_kind: Exceptions.err_kind
@ -93,7 +93,7 @@ val update : t -> t -> unit
(** Update an old error log with a new one *)
val log_issue :
Exceptions.err_kind -> t -> Location.t -> int * Digest.t -> int -> loc_trace
Exceptions.err_kind -> t -> Location.t -> int * Caml.Digest.t -> int -> loc_trace
-> ?linters_def_file:string -> ?doc_url:string -> ?access:string -> exn -> unit
(** {2 Functions for manipulating per-file error tables} *)

@ -686,7 +686,7 @@ let print_key = false
(** pretty print an error *)
let pp_err ~node_key loc ekind ex_name desc ml_loc_opt fmt () =
let kind = err_kind_string (if equal_err_kind ekind Kinfo then Kwarning else ekind) in
let pp_key fmt k = if print_key then F.fprintf fmt " key: %s " (Digest.to_hex k) else () in
let pp_key fmt k = if print_key then F.fprintf fmt " key: %s " (Caml.Digest.to_hex k) else () in
F.fprintf fmt "%a:%d: %s: %a %a%a%a@\n" SourceFile.pp loc.Location.file loc.Location.line kind
IssueType.pp ex_name Localise.pp_error_desc desc pp_key node_key L.pp_ml_loc_opt ml_loc_opt

@ -158,7 +158,7 @@ val print_exception_html : string -> exn -> unit
(** print a description of the exception to the html output *)
val pp_err :
node_key:Digest.t -> Location.t -> err_kind -> IssueType.t -> Localise.error_desc
node_key:Caml.Digest.t -> Location.t -> err_kind -> IssueType.t -> Localise.error_desc
-> Logging.ml_loc option -> Format.formatter -> unit -> unit
(** pretty print an error *)

@ -179,7 +179,6 @@ let rec eval_arithmetic_binop op e1 e2 =
| _ ->
None
and eval = function
| Constant c ->
Some c
@ -196,4 +195,3 @@ and eval = function
| _ ->
(* TODO: handle bitshifting cases, port eval_binop from RacerD.ml *)
None

@ -127,4 +127,3 @@ let of_sil ~include_array_indexes ~f_resolve_id (instr: Sil.instr) =
| Declare_locals _ ->
(* these don't seem useful for most analyses. can translate them later if we want to *)
Ignore

@ -39,7 +39,6 @@ module Name = struct
spec
| FromString s ->
s
end
type name = Name.t [@@deriving compare]
@ -159,7 +158,6 @@ module NameGenerator = struct
let new_stamp = max curr_stamp stamp in
NameHash.replace !name_map name new_stamp
with Not_found -> NameHash.add !name_map name stamp
end
(** Name used for the return variable *)

@ -203,7 +203,6 @@ td.rowname { text-align:right; font-weight:bold; color:#444444; padding-right:2e
~pos:(Some pos) ~path:path_to_node fmt
(node_name ^ "#" ^ pos) ;
F.fprintf fmt "(%a)" (pp_line_link source path_to_root) linenum
end
(* =============== END of module Html =============== *)
@ -341,7 +340,6 @@ module Xml = struct
if on_several_lines then pp_prelude fmt ;
pp_node newline "" fmt node ;
if on_several_lines then pp fmt "@."
end
(* =============== END of module Xml =============== *)

@ -59,4 +59,3 @@ let load_issues_to_errlog_map dir =
()
in
match children_opt with Some children -> Array.iter ~f:load_issues_to_map children | None -> ()

@ -116,7 +116,6 @@ module Tags = struct
~f:(fun (tag, value) ->
if String.Set.mem line_tags tag then Some (int_of_string value) else None )
tags
end
type error_desc =
@ -607,14 +606,16 @@ let dereference_string proc_name deref_str value_str access_opt loc =
let annotation_name = nullable_annotation_name proc_name in
match (Tags.get !tags Tags.nullable_src, Tags.get !tags Tags.weak_captured_var_src) with
| Some nullable_src, _ ->
if String.equal nullable_src value_str then "is annotated with " ^ annotation_name
^ " and is dereferenced without a null check"
else "is indirectly marked " ^ annotation_name ^ " (source: "
if String.equal nullable_src value_str then
"is annotated with " ^ annotation_name ^ " and is dereferenced without a null check"
else
"is indirectly marked " ^ annotation_name ^ " (source: "
^ MF.monospaced_to_string nullable_src ^ ") and is dereferenced without a null check"
| None, Some weak_var_str ->
if String.equal weak_var_str value_str then
"is a weak pointer captured in the block and is dereferenced without a null check"
else "is equal to the variable " ^ MF.monospaced_to_string weak_var_str
else
"is equal to the variable " ^ MF.monospaced_to_string weak_var_str
^ ", a weak pointer captured in the block, and is dereferenced without a null check"
| None, None ->
deref_str.problem_str
@ -690,8 +691,8 @@ let desc_allocation_mismatch alloc dealloc =
Tags.update tags tag_line (string_of_int loc.Location.line) ;
let by_call =
if Typ.Procname.equal primitive_pname called_pname then ""
else " by call to "
^ MF.monospaced_to_string (Typ.Procname.to_simplified_string called_pname)
else
" by call to " ^ MF.monospaced_to_string (Typ.Procname.to_simplified_string called_pname)
in
"using " ^ MF.monospaced_to_string (Typ.Procname.to_simplified_string primitive_pname)
^ by_call ^ " " ^ at_line (Tags.create ()) (* ignore the tag *) loc

@ -42,4 +42,3 @@ let pp_file_pos f (loc: t) =
let fname = SourceFile.to_string loc.file in
let pos = to_string loc in
F.fprintf f "%s:%s" fname pos

@ -201,11 +201,9 @@ module Core_foundation_model = struct
let is_core_lib_create typ funct =
is_core_lib_type typ
&& (String.is_substring ~substring:create funct || String.is_substring ~substring:copy funct)
end
let is_core_lib_type typ = Core_foundation_model.is_core_lib_type typ
let is_malloc_model return_type pname =
Core_foundation_model.is_core_lib_create return_type (Typ.Procname.to_string pname)

@ -251,7 +251,6 @@ module Node = struct
in
let pp fmt = F.fprintf fmt "%s@\n%a@?" str (pp_instrs pe None ~sub_instrs:true) node in
F.asprintf "%t" pp
end
(* =============== END of module Node =============== *)
@ -593,4 +592,3 @@ let has_modify_in_block_attr procdesc pvar =
ProcAttributes.var_attribute_equal attr ProcAttributes.Modify_in_block )
in
List.exists ~f:pvar_local_matches (get_locals procdesc)

@ -754,7 +754,6 @@ module Procname = struct
let ( $!--> ) args_matcher f =
args_matcher $* exact_args_or_retry wrong_args_internal_error $*--> f
end
module TypName = struct

@ -52,6 +52,7 @@ let compare_modulo_this x y =
else if String.equal "this" (Mangled.to_string x.pv_name) then 0
else compare_pvar_kind x.pv_kind y.pv_kind
let equal = [%compare.equal : t]
let pp_translation_unit fmt = function

@ -73,8 +73,9 @@ module Match = struct
let qualifiers_list_matcher ?prefix quals_list =
( if List.is_empty quals_list then "a^" (* regexp that does not match anything *)
else List.rev_map ~f:(regexp_string_of_qualifiers ?prefix) quals_list
|> String.concat ~sep:"\\|" )
else
List.rev_map ~f:(regexp_string_of_qualifiers ?prefix) quals_list |> String.concat ~sep:"\\|"
)
|> Str.regexp
@ -100,5 +101,4 @@ module Match = struct
instantiations *)
let normalized_qualifiers = strip_template_args quals in
Str.string_match matcher (to_separated_string ~sep:matching_separator normalized_qualifiers) 0
end

@ -619,7 +619,6 @@ end = struct
| [] ->
()
done
end
let pp_texp_simple pe =
@ -1402,7 +1401,7 @@ let sub_no_duplicated_ids sub = not (List.contains_dup ~compare:compare_ident_ex
For all (id1, e1), (id2, e2) in the input list,
if id1 = id2, then e1 = e2. *)
let exp_subst_of_list sub =
let sub' = List.dedup ~compare:compare_ident_exp sub in
let sub' = List.dedup_and_sort ~compare:compare_ident_exp sub in
assert (sub_no_duplicated_ids sub') ;
sub'
@ -1410,7 +1409,7 @@ let exp_subst_of_list sub =
let subst_of_list sub = `Exp (exp_subst_of_list sub)
(** like exp_subst_of_list, but allow duplicate ids and only keep the first occurrence *)
let exp_subst_of_list_duplicates sub = List.dedup ~compare:compare_ident_exp_ids sub
let exp_subst_of_list_duplicates sub = List.dedup_and_sort ~compare:compare_ident_exp_ids sub
(** Convert a subst to a list of pairs. *)
let sub_to_list sub = sub

@ -298,4 +298,3 @@ let case_analysis_basic tenv (c1, st) (c2, (_, flag2)) =
let case_analysis tenv (c1, st1) (c2, st2) =
if Config.subtype_multirange then get_subtypes tenv (c1, st1) (c2, st2)
else case_analysis_basic tenv (c1, st1) (c2, st2)

@ -128,8 +128,8 @@ let global_tenv : t option ref = ref None
(** Load a type environment from a file *)
let load_from_file (filename: DB.filename) : t option =
if DB.equal_filename filename DB.global_tenv_fname then (
if is_none !global_tenv then global_tenv
:= Serialization.read_from_file tenv_serializer DB.global_tenv_fname ;
if is_none !global_tenv then
global_tenv := Serialization.read_from_file tenv_serializer DB.global_tenv_fname ;
!global_tenv )
else Serialization.read_from_file tenv_serializer filename
@ -157,4 +157,3 @@ let language_is tenv lang =
Config.equal_language lang Java
| exception Found _ ->
Config.equal_language lang Clang

@ -816,8 +816,8 @@ module Procname = struct
| Simple ->
(* methodname(...) or without ... if there are no parameters *)
let cls_prefix =
if withclass then java_type_to_string_verbosity (split_typename j.class_name) verbosity
^ "."
if withclass then
java_type_to_string_verbosity (split_typename j.class_name) verbosity ^ "."
else ""
in
let params = match j.parameters with [] -> "" | _ -> "..." in
@ -1186,7 +1186,6 @@ module Procname = struct
let serialize pname =
let default () = Sqlite3.Data.TEXT (to_filename pname) in
Base.Hashtbl.find_or_add pname_to_key pname ~default
end
(** given two template arguments, try to generate mapping from generic ones to concrete ones. *)
@ -1242,7 +1241,6 @@ module Procname = struct
|> extract_mapping
| _ ->
None
end
(** Return the return type of [pname_java]. *)
@ -1352,7 +1350,6 @@ module Fieldname = struct
String.is_prefix ~prefix:"val$" (to_flat_string field_name)
| Clang _ ->
false
end
end
@ -1445,5 +1442,4 @@ module Struct = struct
None )
| _ ->
None
end

@ -640,5 +640,4 @@ module Struct : sig
val get_field_type_and_annotation :
lookup:lookup -> Fieldname.t -> typ -> (typ * Annot.Item.t) option
(** Return the type of the field [fn] and its annotation, None if [typ] has no field named [fn] *)
end

@ -137,8 +137,8 @@ module Pair (Domain1 : S) (Domain2 : S) = struct
let ( <= ) ~lhs ~rhs =
if phys_equal lhs rhs then true
else Domain1.( <= ) ~lhs:(fst lhs) ~rhs:(fst rhs)
&& Domain2.( <= ) ~lhs:(snd lhs) ~rhs:(snd rhs)
else
Domain1.( <= ) ~lhs:(fst lhs) ~rhs:(fst rhs) && Domain2.( <= ) ~lhs:(snd lhs) ~rhs:(snd rhs)
let join astate1 astate2 =

@ -162,7 +162,6 @@ struct
let cfg = CFG.from_pdesc pdesc in
let inv_map = exec_cfg cfg proc_data ~initial ~debug in
extract_post (CFG.id (CFG.exit_node cfg)) inv_map
end
module MakeWithScheduler (C : ProcCfg.S) (S : Scheduler.Make) (T : TransferFunctions.MakeSIL) =

@ -28,7 +28,6 @@ module PP = struct
in
F.fprintf fmt "%a:%d@\n" SourceFile.pp loc.Location.file loc.Location.line ;
for n = loc.Location.line - nbefore to loc.Location.line + nafter do printline n done
end
(* PP *)
@ -109,5 +108,4 @@ module ST = struct
(Typ.Procname.to_string proc_name) ;
L.progress "%s@." description ;
Reporting.log_error_deprecated proc_name ~loc ~ltr:trace exn )
end

@ -84,7 +84,6 @@ struct
if phys_equal actual_state actual_state' then astate else (actual_state', id_map)
| Ignore ->
astate
end
module MakeAbstractInterpreterWithConfig
@ -98,7 +97,6 @@ struct
Preanal.do_preanalysis pdesc tenv ;
let initial' = (initial, IdAccessPathMapDomain.empty) in
Option.map ~f:fst (Interpreter.compute_post ~debug:false proc_data ~initial:initial')
end
module MakeAbstractInterpreter = MakeAbstractInterpreterWithConfig (DefaultConfig)

@ -431,4 +431,3 @@ let rec find_superclasses_with_attributes check tenv tname =
if check struct_typ.annots then tname :: result_from_supers else result_from_supers
| _ ->
[]

@ -84,7 +84,6 @@ module InstrNode = struct
Procdesc.Node.pp_id fmt id
| Instr_index i ->
F.fprintf fmt "(%a: %d)" Procdesc.Node.pp_id id i
end
module type S = sig
@ -289,7 +288,6 @@ struct
let id = (Procdesc.Node.get_id t, Instr_index i) in
(instr, Some id) )
(instrs t)
end
module NodeIdMap (CFG : S) = Caml.Map.Make (struct

@ -70,7 +70,6 @@ module ReversePostorder (CFG : ProcCfg.S) = struct
let visited_preds' = IdSet.add node_id t.visited_preds in
let priority' = compute_priority cfg t.node visited_preds' in
{t with visited_preds= visited_preds'; priority= priority'}
end
type t = {worklist: WorkUnit.t M.t; cfg: CFG.t}

@ -36,5 +36,4 @@ module Make (P : Payload) : S with type payload = P.payload = struct
None
| Some summary ->
P.read_payload summary
end

@ -38,8 +38,7 @@ let add_or_replace_check_changed tenv check_attribute_change prop atom =
let _, nexp = List.hd_exn pairs in
(* len exps0 > 0 by match *)
let atom_map = function
| Sil.Apred (att, exp :: _)
| Anpred (att, exp :: _)
| (Sil.Apred (att, exp :: _) | Anpred (att, exp :: _))
when Exp.equal nexp exp && attributes_in_same_category att att0 ->
check_attribute_change att att0 ; atom
| atom' ->
@ -268,8 +267,8 @@ let find_arithmetic_problem tenv proc_node_session prop exp =
| Exp.UnOp (_, e, _) ->
walk e
| Exp.BinOp (op, e1, e2) ->
if Binop.equal op Binop.Div || Binop.equal op Binop.Mod then exps_divided
:= e2 :: !exps_divided ;
if Binop.equal op Binop.Div || Binop.equal op Binop.Mod then
exps_divided := e2 :: !exps_divided ;
walk e1 ;
walk e2
| Exp.Exn _ ->
@ -409,4 +408,3 @@ let find_equal_formal_path tenv e prop =
Some vfs
| _ ->
None

@ -397,6 +397,7 @@ let execute___set_mem_attribute {Builtin.tenv; pdesc; prop_; path; ret_id; args;
| _ ->
raise (Exceptions.Wrong_argument_number __POS__)
let set_attr tenv pdesc prop path exp attr =
let pname = Procdesc.get_proc_name pdesc in
let n_lexp, prop = check_arith_norm_exp tenv pname exp prop in

@ -134,4 +134,3 @@ let to_files {introduced; fixed; preexisting} destdir =
Out_channel.write_all (destdir ^/ "fixed.json") ~data:(Jsonbug_j.string_of_report fixed) ;
Out_channel.write_all (destdir ^/ "preexisting.json")
~data:(Jsonbug_j.string_of_report preexisting)

@ -123,7 +123,7 @@ let skip_duplicated_types_on_filenames renamings (diff: Differential.t) : Differ
String.compare f1 f2
in
let cmp ((issue1, _) as issue_with_previous_file1) ((issue2, _) as issue_with_previous_file2) =
[%compare : Digest.t * string * issue_file_with_renaming]
[%compare : Caml.Digest.t * string * issue_file_with_renaming]
(issue1.Jsonbug_t.key, issue1.Jsonbug_t.bug_type, issue_with_previous_file1)
(issue2.Jsonbug_t.key, issue2.Jsonbug_t.bug_type, issue_with_previous_file2)
in
@ -180,7 +180,7 @@ let value_of_qualifier_tag qts tag =
type file_extension = string [@@deriving compare]
type weak_hash = string * string * string * Digest.t * string option [@@deriving compare]
type weak_hash = string * string * string * Caml.Digest.t * string option [@@deriving compare]
let skip_anonymous_class_renamings (diff: Differential.t) : Differential.t =
(*

@ -134,8 +134,8 @@ let main ~changed_files ~makefile =
in
let n_clusters_to_analyze = List.length clusters_to_analyze in
L.progress "Found %d%s source file%s to analyze in %s@." n_clusters_to_analyze
( if Config.reactive_mode || Option.is_some changed_files then " (out of "
^ string_of_int (List.length all_clusters) ^ ")"
( if Config.reactive_mode || Option.is_some changed_files then
" (out of " ^ string_of_int (List.length all_clusters) ^ ")"
else "" )
(if Int.equal n_clusters_to_analyze 1 then "" else "s")
Config.results_dir ;

@ -56,7 +56,7 @@ let compute_hash (kind: string) (type_str: string) (proc_name: Typ.Procname.t) (
in
Utils.better_hash
(kind, type_str, hashable_procedure_name, base_filename, location_independent_qualifier)
|> Digest.to_hex
|> Caml.Digest.to_hex
let exception_value = "exception"
@ -177,7 +177,6 @@ module ProcsCsv = struct
pp "%d," sv.vline ;
pp "\"%s\"," (Escape.escape_csv sv.vsignature) ;
pp "%s@\n" sv.vproof_trace
end
let should_report (issue_kind: Exceptions.err_kind) issue_type error_desc eclass =
@ -290,7 +289,7 @@ module IssuesJson = struct
; procedure_start_line
; file
; bug_trace= loc_trace_to_jsonbug_record err_data.loc_trace key.err_kind
; key= err_data.node_id_key.node_key |> Digest.to_hex
; key= err_data.node_id_key.node_key |> Caml.Digest.to_hex
; qualifier_tags= Localise.Tags.tag_value_records_of_tags key.err_desc.tags
; hash= compute_hash kind bug_type procname file qualifier
; dotty= error_desc_to_dotty_string key.err_desc
@ -309,7 +308,6 @@ module IssuesJson = struct
(** Write bug report in JSON format *)
let pp_issues_of_error_log fmt error_filter _ proc_loc_opt procname err_log =
Errlog.iter (pp_issue fmt error_filter procname proc_loc_opt) err_log
end
let pp_custom_of_report fmt report fields =
@ -352,9 +350,9 @@ let pp_custom_of_report fmt report fields =
| `Issue_field_bug_trace ->
pp_trace fmt issue.bug_trace (comma_separator index)
| `Issue_field_key ->
Format.fprintf fmt "%s%s" (comma_separator index) (Digest.to_hex issue.key)
Format.fprintf fmt "%s%s" (comma_separator index) (Caml.Digest.to_hex issue.key)
| `Issue_field_hash ->
Format.fprintf fmt "%s%s" (comma_separator index) (Digest.to_hex issue.hash)
Format.fprintf fmt "%s%s" (comma_separator index) (Caml.Digest.to_hex issue.hash)
| `Issue_field_line_offset ->
Format.fprintf fmt "%s%d" (comma_separator index)
(issue.line - issue.procedure_start_line)
@ -371,7 +369,7 @@ let pp_custom_of_report fmt report fields =
let tests_jsonbug_compare bug1 bug2 =
let open Jsonbug_t in
[%compare : string * string * int * string * Digest.t]
[%compare : string * string * int * string * Caml.Digest.t]
(bug1.file, bug1.procedure, bug1.line - bug1.procedure_start_line, bug1.bug_type, bug1.hash)
(bug2.file, bug2.procedure, bug2.line - bug2.procedure_start_line, bug2.bug_type, bug2.hash)
@ -395,7 +393,6 @@ module IssuesTxt = struct
(** Write bug report in text format *)
let pp_issues_of_error_log fmt error_filter _ proc_loc_opt _ err_log =
Errlog.iter (pp_issue fmt error_filter proc_loc_opt) err_log
end
let pp_text_of_report fmt report =
@ -423,7 +420,6 @@ module CallsCsv = struct
pp "%a@\n" Specs.CallStats.pp_trace trace
in
Specs.CallStats.iter do_call stats.Specs.call_stats
end
module Stats = struct
@ -559,7 +555,6 @@ module Stats = struct
F.fprintf fmt "@\n -------------------@\n" ;
F.fprintf fmt "@\nDetailed Errors@\n@\n" ;
List.iter ~f:(fun s -> F.fprintf fmt "%s@\n" s) (List.rev stats.saved_errors)
end
module Report = struct
@ -605,7 +600,6 @@ module PreconditionStats = struct
L.result "Procedures with empty precondition: %d@." !nr_empty ;
L.result "Procedures with only allocation conditions: %d@." !nr_onlyallocation ;
L.result "Procedures with data constraints: %d@." !nr_dataconstraints
end
(* Wrapper of an issue that compares all parts except the procname *)
@ -631,13 +625,12 @@ module Issue = struct
identical warning on the same line. Accomplish this by sorting without regard to procname, then
de-duplicating. *)
let sort_filter_issues issues =
let issues' = List.dedup ~compare issues in
let issues' = List.dedup_and_sort ~compare issues in
( if Config.developer_mode then
let num_pruned_issues = List.length issues - List.length issues' in
if num_pruned_issues > 0 then
L.user_warning "Note: pruned %d duplicate issues@\n" num_pruned_issues ) ;
issues'
end
let error_filter filters proc_name file error_desc error_name =
@ -918,7 +911,6 @@ module AnalysisResults = struct
iterator_of_summary_list r
| None ->
L.(die UserError) "Error: cannot open analysis results file %s@." fname
end
let register_perf_stats_report () =

@ -59,4 +59,3 @@ let try_capture (attributes: ProcAttributes.t) : ProcAttributes.t option =
Caveat: it's possible that procedure will be captured in some other unrelated file
later - infer may ignore it then. *)
Attributes.load_defined attributes.proc_name

@ -153,4 +153,3 @@ let register_report_at_exit =
String.Table.set registered_files ~key:file ~data:() ;
if not Config.buck_cache_mode then
Epilogues.register ~f:(report_at_exit file) ("stats reporting in " ^ file) )

@ -189,4 +189,3 @@ let remove_seed_vars tenv (prop: 'a Prop.t) : Prop.normal Prop.t =
let sigma = prop.sigma in
let sigma' = List.filter ~f:hpred_not_seed sigma in
Prop.normalize tenv (Prop.set prop ~sigma:sigma')

@ -182,4 +182,3 @@ let report_cycle tenv hpred original_prop =
Some (exn_retain_cycle tenv prop hpred cycle)
| _ ->
None

@ -179,4 +179,3 @@ let generate_files () =
write_to_json_file_opt
(Filename.concat aggregated_reporting_stats_dir aggregated_stats_filename)
j.reporting_json_data

@ -67,5 +67,4 @@ module Runner = struct
let complete runner =
ProcessPool.wait_all runner.pool ;
Queue.iter ~f:(fun f -> f ()) runner.all_continuations
end

@ -926,7 +926,7 @@ let abstract_gc tenv p =
let no_fav_e1 = Sil.fav_is_empty fav_e1 in
let no_fav_e2 = Sil.fav_is_empty fav_e2 in
(no_fav_e1 || intersect_e1 ()) && (no_fav_e2 || intersect_e2 ())
| Sil.Apred _ | Anpred _ as a ->
| (Sil.Apred _ | Anpred _) as a ->
let fav_a = Sil.atom_fav a in
Sil.fav_is_empty fav_a
|| IList.intersect Ident.compare (Sil.fav_to_list fav_a) (Sil.fav_to_list fav_p_without_pi)
@ -1111,8 +1111,7 @@ let check_junk ?original_prop pname tenv prop =
in
let ml_bucket_opt =
match resource with
| PredSymb.Rmemory PredSymb.Mnew
| PredSymb.Rmemory PredSymb.Mnew_array
| (PredSymb.Rmemory PredSymb.Mnew | PredSymb.Rmemory PredSymb.Mnew_array)
when Config.curr_language_is Config.Clang ->
Mleak_buckets.should_raise_cpp_leak
| _ ->
@ -1137,9 +1136,7 @@ let check_junk ?original_prop pname tenv prop =
(false, exn)
| None ->
(true, exn_leak) )
| Some _, Rmemory Mobjc
| Some _, Rmemory Mnew
| Some _, Rmemory Mnew_array
| (Some _, Rmemory Mobjc | Some _, Rmemory Mnew | Some _, Rmemory Mnew_array)
when Config.curr_language_is Config.Clang ->
(is_none ml_bucket_opt, exn_leak)
| Some _, Rmemory _ ->
@ -1327,5 +1324,4 @@ let lifted_abstract pname tenv pset =
let abstracted_pset = Propset.map_option tenv f pset in
abstracted_pset
(***************** End of Main Abstraction Functions *****************)

@ -286,7 +286,6 @@ end = struct
in
let hpred' = hpred_replace_strexp tenv footprint_part hpred syn_offs update in
replace_hpred (sigma, hpred, syn_offs) hpred'
end
(** This function renames expressions in [p]. The renaming is, roughly
@ -690,4 +689,3 @@ let remove_redundant_elements tenv prop =
let prop' = Prop.set prop ~sigma:sigma' ~sigma_fp:sigma_fp' in
Prop.normalize tenv prop'
else prop

@ -70,4 +70,3 @@ let pp_registered fmt () =
let print_and_exit () =
pp_registered Format.std_formatter () ;
L.exit 0

@ -49,4 +49,3 @@ let pp_cluster fmt (nr, cluster) =
(* touch the target of the rule to let `make` know that the job has been done *)
F.fprintf fmt "\t%@touch $%@@\n" ;
F.fprintf fmt "@\n"

@ -49,4 +49,3 @@ let create_cluster_makefile (clusters: Cluster.t list) (fname: string) =
List.iteri ~f:do_cluster clusters ;
pp_epilog fmt () ;
Out_channel.close outc

@ -53,7 +53,7 @@ let stitch_summaries stacktrace_file summary_files out_file =
let summary_map =
List.fold
~f:(fun acc stacktree ->
String.Map.add ~key:(frame_id_of_summary stacktree) ~data:stacktree acc)
String.Map.set ~key:(frame_id_of_summary stacktree) ~data:stacktree acc )
~init:String.Map.empty summaries
in
let expand_stack_frame frame =

@ -181,7 +181,6 @@ end = struct
let set = lookup_const' const_tbl r in
List.for_all ~f:(fun v' -> Exp.equal (find' tbl v') r) vars'
&& List.for_all ~f:(fun c -> Exp.Set.mem c set) nonvars
end
(** {2 Modules for checking whether join or meet loses too much info} *)
@ -234,7 +233,6 @@ end = struct
not (Exp.Set.mem e lexps)
| _ ->
false
end
module CheckJoinPre : InfoLossCheckerSig = struct
@ -356,7 +354,6 @@ end = struct
CheckJoinPre.add side e1 e2
| JoinState.Post ->
CheckJoinPost.add side e1 e2
end
module CheckMeet : InfoLossCheckerSig = struct
@ -452,7 +449,6 @@ end = struct
let res = !tbl in
tbl := [] ;
res
end
(** {2 Module for introducing fresh variables} *)
@ -553,7 +549,6 @@ end = struct
acc
in
List.fold ~f:f_ineqs ~init:eqs t_minimal
end
(** {2 Modules for renaming} *)
@ -868,7 +863,6 @@ end = struct
in
let entry = (e1, e2, e) in
push entry ; Todo.push entry ; e
end
(** {2 Functions for constructing fresh sil data types} *)
@ -1897,8 +1891,9 @@ let prop_partial_meet tenv p1 p2 =
FreshVarExp.init () ;
Todo.init () ;
try
SymOp.try_finally ~f:(fun () -> Some (eprop_partial_meet tenv p1 p2)) ~finally:(fun () ->
Rename.final () ; FreshVarExp.final () ; Todo.final () )
SymOp.try_finally
~f:(fun () -> Some (eprop_partial_meet tenv p1 p2))
~finally:(fun () -> Rename.final () ; FreshVarExp.final () ; Todo.final ())
with Sil.JoinFail -> None
@ -2011,7 +2006,8 @@ let prop_partial_join pname tenv mode p1 p2 =
Todo.reset rename_footprint ;
let res = eprop_partial_join' tenv mode (Prop.expose p1') (Prop.expose p2') in
if !Config.footprint then JoinState.set_footprint false ;
Some res) ~finally:(fun () -> Rename.final () ; FreshVarExp.final () ; Todo.final () )
Some res )
~finally:(fun () -> Rename.final () ; FreshVarExp.final () ; Todo.final ())
with Sil.JoinFail -> None )
| Some _ ->
res_by_implication_only
@ -2022,8 +2018,9 @@ let eprop_partial_join tenv mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed P
Rename.init () ;
FreshVarExp.init () ;
Todo.init () ;
SymOp.try_finally ~f:(fun () -> eprop_partial_join' tenv mode ep1 ep2) ~finally:(fun () ->
Rename.final () ; FreshVarExp.final () ; Todo.final () )
SymOp.try_finally
~f:(fun () -> eprop_partial_join' tenv mode ep1 ep2)
~finally:(fun () -> Rename.final () ; FreshVarExp.final () ; Todo.final ())
(** {2 Join and Meet for Propset} *)
@ -2232,4 +2229,3 @@ let propset_meet_generate_pre tenv pset =
let plist_old = Propset.to_proplist pset in
let plist_new = Propset.to_proplist pset_new in
plist_new @ plist_old

@ -111,10 +111,11 @@ let print_stack_info = ref false
(* replace a dollar sign in a name with a D. We need this because dotty get confused if there is*)
(* a dollar sign i a label*)
let strip_special_chars b =
let b = Bytes.of_string b in
let replace st c c' =
if String.contains st c then
let idx = String.index_exn st c in
try st.[idx] <- c' ; st with Invalid_argument _ ->
if Bytes.contains st c then
let idx = String.index_exn (Bytes.to_string st) c in
try Bytes.set st idx c' ; st with Invalid_argument _ ->
L.internal_error "@\n@\nstrip_special_chars: Invalid argument!@\n@." ;
assert false
else st
@ -127,7 +128,7 @@ let strip_special_chars b =
let s5 = replace s4 ')' 'B' in
let s6 = replace s5 '+' 'P' in
let s7 = replace s6 '-' 'M' in
s7
Bytes.to_string s7
let rec strexp_to_string pe coo f se =
@ -1733,4 +1734,3 @@ let print_specs_xml signature specs loc fmt =
[xml_signature; xml_specifications]
in
Io_infer.Xml.pp_document true fmt proc_summary

@ -1331,4 +1331,3 @@ let explain_null_test_after_dereference tenv exp node line loc =
let warning_err loc fmt_string =
L.(debug Analysis Medium) ("%a: Warning: " ^^ fmt_string) Location.pp loc

@ -218,4 +218,3 @@ let iter_files f exe_env =
SourceFile.Set.add fname seen_files_acc )
in
ignore (Typ.Procname.Hash.fold do_file exe_env.proc_map SourceFile.Set.empty)

@ -38,7 +38,8 @@ let setup () =
if not
( Driver.(equal_mode driver_mode Analyze)
||
Config.(buck || continue_capture || infer_is_clang || infer_is_javac || reactive_mode) )
Config.(buck || continue_capture || infer_is_clang || infer_is_javac || reactive_mode)
)
then ResultsDir.remove_results_dir () ;
ResultsDir.create_results_dir ()
| Explore ->

@ -83,7 +83,6 @@ module FileContainsStringMatcher = struct
source_map := SourceFile.Map.add source_file pattern_found !source_map ;
pattern_found
with Sys_error _ -> false
end
type method_pattern =
@ -106,7 +105,7 @@ module FileOrProcMatcher = struct
List.fold
~f:(fun map pattern ->
let previous = try String.Map.find_exn map pattern.class_name with Not_found -> [] in
String.Map.add ~key:pattern.class_name ~data:(pattern :: previous) map)
String.Map.set ~key:pattern.class_name ~data:(pattern :: previous) map )
~init:String.Map.empty m_patterns
in
let do_java pname_java =
@ -171,7 +170,6 @@ module FileOrProcMatcher = struct
Format.fprintf fmt "Source contains (%s) {@\n%a}@\n"
(Config.string_of_language language)
pp_source_contains sc
end
(* of module FileOrProcMatcher *)
@ -186,7 +184,6 @@ module OverridesMatcher = struct
L.(die UserError) "Expecting method pattern"
in
List.exists ~f:is_matching patterns
end
let patterns_of_json_with_key (json_key, json) =
@ -371,4 +368,3 @@ let test () =
let matching_s = String.concat ~sep:", " (List.map ~f:fst matching) in
L.result "%s -> {%s}@." (SourceFile.to_rel_path source_file) matching_s )
(Sys.getcwd ())

@ -62,7 +62,6 @@ module NodeVisitSet = Caml.Set.Make (struct
| _ ->
compare_number_of_visits x1 x2
else compare_ids x1.node x2.node
end)
(** Table for the results of the join operation on nodes. *)
@ -122,7 +121,6 @@ module Worklist = struct
with Not_found ->
L.internal_error "@\n...Work list is empty! Impossible to remove edge...@\n" ;
assert false
end
(* =============== END of module Worklist =============== *)
@ -1230,7 +1228,8 @@ let transition_footprint_re_exe tenv proc_name joined_pres =
let specs =
List.map
~f:(fun jp ->
Specs.spec_normalize tenv {Specs.pre= jp; posts= []; visited= Specs.Visitedset.empty})
Specs.spec_normalize tenv {Specs.pre= jp; posts= []; visited= Specs.Visitedset.empty}
)
joined_pres
in
let payload = {summary.Specs.payload with Specs.preposts= Some specs} in

@ -936,4 +936,3 @@ let hpara_dll_create tenv corres sigma1 root1 blink1 flink1 =
; Sil.body_dll= body }
in
(hpara_dll, es_shared)

@ -129,8 +129,8 @@ let process_merge_file deps_file =
match Str.split_delim (Str.regexp (Str.quote "\t")) line with
| target :: _ :: target_results_dir :: _ ->
let infer_out_src =
if Filename.is_relative target_results_dir then Filename.dirname (buck_out ())
^/ target_results_dir
if Filename.is_relative target_results_dir then
Filename.dirname (buck_out ()) ^/ target_results_dir
else target_results_dir
in
let skiplevels = 2 in
@ -156,4 +156,3 @@ let merge_captured_targets () =
MergeResults.merge_buck_flavors_results infer_deps_file ;
process_merge_file infer_deps_file ;
L.progress "Merging captured Buck targets took %a@\n%!" Mtime.Span.pp (Mtime_clock.count time0)

@ -211,4 +211,3 @@ let analyze_proc_name : Procdesc.t -> Typ.Procname.t -> Specs.summary option =
(** Find a proc desc for the procedure, perhaps loading it from disk. *)
let get_proc_desc callee_pname =
match !callbacks_ref with Some callbacks -> callbacks.get_proc_desc callee_pname | None -> None

@ -253,7 +253,6 @@ end = struct
let stats1 = compute_stats do_calls f path ; get_stats path in
stats.max_length <- stats1.max_length ;
stats.linear_num <- stats1.linear_num
end
(* End of module Invariant *)
@ -548,7 +547,6 @@ end = struct
in
let relevant lt = lt.Errlog.lt_node_tags <> [] in
IList.remove_irrelevant_duplicates compare relevant (List.rev !trace)
end
(* =============== END of the Path module ===============*)
@ -740,7 +738,6 @@ end = struct
(** It's the caller's resposibility to ensure that Prop.prop_rename_primed_footprint_vars was called on the list *)
let from_renamed_list (pl: ('a Prop.t * Path.t) list) : t =
List.fold ~f:(fun ps (p, pa) -> add_renamed_prop p pa ps) ~init:empty pl
end
(* =============== END of the PathSet module ===============*)

@ -108,7 +108,6 @@ module NullifyTransferFunctions = struct
"Should not add nullify instructions before running nullify analysis!"
in
if is_last_instr_in_node instr node then postprocess astate' node extras else astate'
end
module NullifyAnalysis =
@ -199,4 +198,3 @@ let do_abstraction pdesc =
let do_preanalysis pdesc tenv =
if not (Procdesc.did_preanalysis pdesc) then ( do_liveness pdesc tenv ; do_abstraction pdesc )

@ -151,7 +151,6 @@ end = struct
let fd = Hashtbl.find log_files (node_fname, source) in
Unix.close fd ;
curr_html_formatter := F.std_formatter
end
(* =============== END of module NodesHtml =============== *)

@ -1318,8 +1318,7 @@ module Normalize = struct
in
let handle_unary_negation (e1: Exp.t) (e2: Exp.t) =
match (e1, e2) with
| UnOp (LNot, e1', _), Const Cint i
| Const Cint i, UnOp (LNot, e1', _)
| (UnOp (LNot, e1', _), Const Cint i | Const Cint i, UnOp (LNot, e1', _))
when IntLit.iszero i ->
(e1', Exp.zero, true)
| _ ->
@ -1712,7 +1711,6 @@ module Normalize = struct
let nprop = List.fold ~f:(prop_atom_and tenv) ~init:p0 (get_pure_extended eprop) in
unsafe_cast_to_normal
(footprint_normalize tenv (set nprop ~pi_fp:eprop.pi_fp ~sigma_fp:eprop.sigma_fp))
end
(* End of module Normalize *)
@ -2668,7 +2666,6 @@ end = struct
let prop_chain_size p =
let fp_size = pi_size p.pi_fp + sigma_size p.sigma_fp in
pi_size p.pi + sigma_size p.sigma + fp_size
end
(*** END of module Metrics ***)
@ -2729,7 +2726,6 @@ module CategorizePreconditions = struct
OnlyAllocation
| _ :: _, [], [] ->
DataConstraints
end
(* Export for interface *)

@ -90,7 +90,8 @@ let get_subl footprint_part g = if footprint_part then [] else Sil.sub_to_list g
let edge_from_source g n footprint_part is_hpred =
let edges =
if is_hpred then List.map ~f:(fun hpred -> Ehpred hpred) (get_sigma footprint_part g)
else List.map ~f:(fun a -> Eatom a) (get_pi footprint_part g)
else
List.map ~f:(fun a -> Eatom a) (get_pi footprint_part g)
@ List.map ~f:(fun entry -> Esub_entry entry) (get_subl footprint_part g)
in
let starts_from hpred =

@ -102,4 +102,3 @@ let pp pe prop f pset =
let d p ps =
let plist = to_proplist ps in
Propgraph.d_proplist p plist

@ -194,7 +194,6 @@ end = struct
let saturate constraints =
let constraints_cleaned = sort_then_remove_redundancy constraints in
saturate_ constraints_cleaned constraints_cleaned
end
(** Return true if the two types have sizes which can be compared *)
@ -604,7 +603,6 @@ end = struct
List.exists ~f:inconsistent_neq neqs || List.exists ~f:inconsistent_leq leqs
|| List.exists ~f:inconsistent_lt lts
(*
(** Pretty print inequalities and disequalities *)
let pp pe fmt { leqs = leqs; lts = lts; neqs = neqs } =
@ -871,7 +869,7 @@ let get_smt_key a p =
let fmt_tmp = F.formatter_of_out_channel outc_tmp in
let () = F.fprintf fmt_tmp "%a%a" (Sil.pp_atom Pp.text) a (Prop.pp_prop Pp.text) p in
Out_channel.close outc_tmp ;
Digest.to_hex (Digest.file tmp_filename)
Caml.Digest.to_hex (Caml.Digest.file tmp_filename)
(** Check whether [prop |- a]. False means dont know. *)
@ -1323,7 +1321,6 @@ end = struct
d_inner () ;
L.d_strln " returning FALSE" ;
L.d_ln ()
end
let d_impl (s1, s2) = ProverState.d_implication (`Exp s1, `Exp s2)
@ -1939,7 +1936,6 @@ module Subtyping_check = struct
| _ ->
(* don't know, consider both possibilities *)
(Some texp1, Some texp1)
end
let cast_exception tenv texp1 texp2 e1 subs =
@ -2774,7 +2770,6 @@ let find_minimum_pure_cover tenv cases =
let shrink cases = if List.length cases > 2 then shrink_ [] cases else cases in
try Some (shrink (grow [] cases)) with NO_COVER -> None
(*
(** Check [prop |- e1<e2]. Result [false] means "don't know". *)
let check_lt prop e1 e2 =

@ -1775,4 +1775,3 @@ let rearrange ?(report_deref_errors= true) pdesc tenv lexp typ prop loc
raise (Exceptions.Symexec_memory_error __POS__) )
| Some iter ->
iter_rearrange pname tenv nlexp typ prop' iter inst

@ -11,7 +11,7 @@ open! IStd
module L = Logging
type log_t =
?loc:Location.t -> ?node_id:int * Digest.t -> ?session:int -> ?ltr:Errlog.loc_trace
?loc:Location.t -> ?node_id:int * Caml.Digest.t -> ?session:int -> ?ltr:Errlog.loc_trace
-> ?linters_def_file:string -> ?doc_url:string -> ?access:string -> exn -> unit
type log_issue_from_errlog = Errlog.t -> log_t
@ -24,7 +24,7 @@ let log_issue_from_errlog err_kind err_log ?loc ?node_id ?session ?ltr ?linters_
let node_id =
match node_id with
| None ->
(State.get_node_id_key () :> int * Digest.t)
(State.get_node_id_key () :> int * Caml.Digest.t)
| Some node_id ->
node_id
in
@ -88,4 +88,3 @@ let log_warning_deprecated ?(store_summary= false) =
let log_info_deprecated ?(store_summary= false) =
log_issue_deprecated ~store_summary Exceptions.Kinfo

@ -12,7 +12,7 @@ open! IStd
(** Type of functions to report issues to the error_log in a spec. *)
type log_t =
?loc:Location.t -> ?node_id:int * Digest.t -> ?session:int -> ?ltr:Errlog.loc_trace
?loc:Location.t -> ?node_id:int * Caml.Digest.t -> ?session:int -> ?ltr:Errlog.loc_trace
-> ?linters_def_file:string -> ?doc_url:string -> ?access:string -> exn -> unit
type log_issue_from_errlog = Errlog.t -> log_t

@ -135,7 +135,6 @@ module Jprop = struct
| Joined (n, p, jp1, jp2) ->
Joined (n, f p, map f jp1, map f jp2)
(*
let rec jprop_sub sub = function
| Prop (n, p) -> Prop (n, Prop.prop_sub sub p)
@ -232,7 +231,6 @@ end = struct
let erase_join_info_pre tenv spec =
let spec' = {spec with pre= Jprop.Prop (1, Jprop.to_prop spec.pre)} in
normalize tenv spec'
end
(** Convert spec into normal form w.r.t. variable renaming *)
@ -311,7 +309,6 @@ module CallStats = struct
in
List.iter ~f:(fun (x, tr) -> f x tr) sorted_elems
(*
let pp fmt t =
let do_call (pname, loc) tr =
@ -579,8 +576,7 @@ let res_dir_specs_filename pname =
(** paths to the .specs file for the given procedure in the current spec libraries *)
let specs_library_filenames pname =
List.map
~f:(fun specs_dir ->
DB.filename_from_string (Filename.concat specs_dir (specs_filename pname)))
~f:(fun specs_dir -> DB.filename_from_string (Filename.concat specs_dir (specs_filename pname)))
Config.specs_library

@ -25,7 +25,7 @@ type failure_stats =
; (* number of node failures (i.e. at least one instruction failure) *)
mutable node_ok: int
; (* number of node successes (i.e. no instruction failures) *)
mutable first_failure: (Location.t * (int * Digest.t) * int * Errlog.loc_trace * exn) option
mutable first_failure: (Location.t * (int * Caml.Digest.t) * int * Errlog.loc_trace * exn) option
(* exception at the first failure *) }
module NodeHash = Procdesc.NodeHash
@ -310,7 +310,7 @@ let mark_instr_ok () =
let mark_instr_fail exn =
let loc = get_loc () in
let key = (get_node_id_key () :> int * Digest.t) in
let key = (get_node_id_key () :> int * Caml.Digest.t) in
let session = get_session () in
let loc_trace = get_loc_trace () in
let fs = get_failure_stats (get_node ()) in
@ -320,7 +320,7 @@ let mark_instr_fail exn =
type log_issue =
?store_summary:bool -> Typ.Procname.t -> ?loc:Location.t -> ?node_id:int * Digest.t
?store_summary:bool -> Typ.Procname.t -> ?loc:Location.t -> ?node_id:int * Caml.Digest.t
-> ?session:int -> ?ltr:Errlog.loc_trace -> ?linters_def_file:string -> ?doc_url:string
-> ?access:string -> exn -> unit

@ -42,7 +42,7 @@ val get_node : unit -> Procdesc.Node.t
val get_node_id : unit -> Procdesc.Node.id
(** Get id of last node seen in symbolic execution *)
val get_node_id_key : unit -> Procdesc.Node.id * Digest.t
val get_node_id_key : unit -> Procdesc.Node.id * Caml.Digest.t
(** Get id and key of last node seen in symbolic execution *)
val get_normalized_pre :
@ -80,7 +80,7 @@ val mk_find_duplicate_nodes : Procdesc.t -> Procdesc.Node.t -> Procdesc.NodeSet.
and normalized (w.r.t. renaming of let - bound ids) list of instructions. *)
type log_issue =
?store_summary:bool -> Typ.Procname.t -> ?loc:Location.t -> ?node_id:int * Digest.t
?store_summary:bool -> Typ.Procname.t -> ?loc:Location.t -> ?node_id:int * Caml.Digest.t
-> ?session:int -> ?ltr:Errlog.loc_trace -> ?linters_def_file:string -> ?doc_url:string
-> ?access:string -> exn -> unit

@ -700,8 +700,7 @@ let resolve_and_analyze tenv caller_pdesc prop args callee_proc_name call_flags
Some resolved_proc_desc
| None ->
Option.map
~f:(fun callee_proc_desc ->
Cfg.specialize_types callee_proc_desc resolved_pname args)
~f:(fun callee_proc_desc -> Cfg.specialize_types callee_proc_desc resolved_pname args)
(Ondemand.get_proc_desc callee_proc_name)
in
Option.bind resolved_proc_desc_option ~f:analyze

@ -789,7 +789,8 @@ let combine tenv ret_id (posts: ('a Prop.t * Paths.Path.t) list) actual_pre path
else
List.map
~f:(fun (p, path_post) ->
(p, Paths.Path.add_call (include_subtrace callee_pname) path_pre callee_pname path_post))
(p, Paths.Path.add_call (include_subtrace callee_pname) path_pre callee_pname path_post)
)
posts
in
List.map
@ -1366,4 +1367,3 @@ let exe_function_call callee_summary tenv ret_id_opt caller_pdesc callee_pname l
in
let results = List.map ~f:exe_one_spec spec_list in
exe_call_postprocess tenv ret_id_opt trace_call callee_pname callee_attrs loc results

@ -124,4 +124,3 @@ let exe_timeout f x =
L.progressbar_timeout_event kind ;
Errdesc.warning_err (State.get_loc ()) "TIMEOUT: %a@." SymOp.pp_failure_kind kind ;
Some kind

@ -283,4 +283,3 @@ let command_to_data =
let data_of_command command =
List.Assoc.find_exn ~equal:CLOpt.equal_command command_to_data command

@ -218,7 +218,6 @@ module SectionMap = Caml.Map.Make (struct
-1
else (* reverse order *)
String.compare s2 s1
end)
let help_sections_desc_lists =
@ -384,8 +383,10 @@ let mk_set var value ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta=
let setter () = var := value in
ignore
(mk ~deprecated ~long ?short ~default:() ?parse_mode ?in_help ~meta doc
~default_to_string:(fun () -> "") ~decode_json:(string_json_decoder ~long)
~mk_setter:(fun _ _ -> setter ()) ~mk_spec:(fun _ -> Unit setter ))
~default_to_string:(fun () -> "")
~decode_json:(string_json_decoder ~long)
~mk_setter:(fun _ _ -> setter ())
~mk_spec:(fun _ -> Unit setter))
let mk_with_reset value ~reset_doc ?deprecated ~long ?parse_mode mk =
@ -405,8 +406,9 @@ let mk_option ?(default= None) ?(default_to_string= fun _ -> "") ~f ?(mk_reset=
?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "string") doc =
let mk () =
mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc ~default_to_string
~decode_json:(string_json_decoder ~long) ~mk_setter:(fun var str -> var := f str) ~mk_spec:
(fun set -> String set )
~decode_json:(string_json_decoder ~long)
~mk_setter:(fun var str -> var := f str)
~mk_spec:(fun set -> String set)
in
if mk_reset then
let reset_doc = reset_doc_opt ~long in
@ -470,8 +472,10 @@ let mk_bool_group ?(deprecated_no= []) ?(default= false) ?f:(f0 = Fn.id) ?(depre
let mk_int ~default ?(f= Fn.id) ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "int")
doc =
mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc
~default_to_string:string_of_int ~mk_setter:(fun var str -> var := f (int_of_string str))
~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set )
~default_to_string:string_of_int
~mk_setter:(fun var str -> var := f (int_of_string str))
~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> String set)
let mk_int_opt ?default ?f:(f0 = Fn.id) ?(deprecated= []) ~long ?short ?parse_mode ?in_help
@ -483,8 +487,10 @@ let mk_int_opt ?default ?f:(f0 = Fn.id) ?(deprecated= []) ~long ?short ?parse_mo
let mk_float ~default ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "float") doc =
mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc
~default_to_string:string_of_float ~mk_setter:(fun var str -> var := float_of_string str)
~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set )
~default_to_string:string_of_float
~mk_setter:(fun var str -> var := float_of_string str)
~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> String set)
let mk_float_opt ?default ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta= "float") doc =
@ -496,8 +502,10 @@ let mk_float_opt ?default ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(
let mk_string ~default ?(f= fun s -> s) ?(deprecated= []) ~long ?short ?parse_mode ?in_help
?(meta= "string") doc =
mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc
~default_to_string:(fun s -> s) ~mk_setter:(fun var str -> var := f str)
~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> String set )
~default_to_string:(fun s -> s)
~mk_setter:(fun var str -> var := f str)
~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> String set)
let mk_string_opt ?default ?(f= fun s -> s) ?mk_reset ?(deprecated= []) ~long ?short ?parse_mode
@ -512,9 +520,10 @@ let mk_string_list ?(default= []) ?(f= fun s -> s) ?(deprecated= []) ~long ?shor
?in_help ?(meta= "string") doc =
let mk () =
mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta:("+" ^ meta) doc
~default_to_string:(String.concat ~sep:",") ~mk_setter:(fun var str -> var := f str :: !var)
~decode_json:(list_json_decoder (string_json_decoder ~long)) ~mk_spec:(fun set -> String set
)
~default_to_string:(String.concat ~sep:",")
~mk_setter:(fun var str -> var := f str :: !var)
~decode_json:(list_json_decoder (string_json_decoder ~long))
~mk_spec:(fun set -> String set)
in
let reset_doc = reset_doc_list ~long in
mk_with_reset [] ~reset_doc ~long ?parse_mode mk
@ -539,7 +548,8 @@ let mk_path_helper ~setter ~default_to_string ~default ~deprecated ~long ~short
~default_to_string
~mk_setter:(fun var str ->
let abs_path = normalize_path_in_args_being_parsed ~is_anon_arg:false str in
setter var abs_path) ~mk_spec:(fun set -> String set )
setter var abs_path )
~mk_spec:(fun set -> String set)
let mk_path ~default ?(f= Fn.id) ?(deprecated= []) ~long ?short ?parse_mode ?in_help
@ -589,8 +599,10 @@ let mk_symbol ~default ~symbols ~eq ?(f= Fn.id) ?(deprecated= []) ~long ?short ?
let to_string sym = List.Assoc.find_exn ~equal:eq sym_to_str sym in
let meta = Option.value meta ~default:(mk_symbols_meta symbols) in
mk ~deprecated ~long ?short ~default ?parse_mode ?in_help ~meta doc
~default_to_string:(fun s -> to_string s) ~mk_setter:(fun var str -> var := of_string str |> f)
~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> Symbol (strings, set) )
~default_to_string:(fun s -> to_string s)
~mk_setter:(fun var str -> var := of_string str |> f)
~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> Symbol (strings, set))
let mk_symbol_opt ~symbols ?(f= Fn.id) ?(mk_reset= true) ?(deprecated= []) ~long ?short ?parse_mode
@ -600,8 +612,10 @@ let mk_symbol_opt ~symbols ?(f= Fn.id) ?(mk_reset= true) ?(deprecated= []) ~long
let meta = Option.value meta ~default:(mk_symbols_meta symbols) in
let mk () =
mk ~deprecated ~long ?short ~default:None ?parse_mode ?in_help ~meta doc
~default_to_string:(fun _ -> "") ~mk_setter:(fun var str -> var := Some (f (of_string str)))
~decode_json:(string_json_decoder ~long) ~mk_spec:(fun set -> Symbol (strings, set) )
~default_to_string:(fun _ -> "")
~mk_setter:(fun var str -> var := Some (f (of_string str)))
~decode_json:(string_json_decoder ~long)
~mk_spec:(fun set -> Symbol (strings, set))
in
if mk_reset then
let reset_doc = reset_doc_opt ~long in
@ -619,8 +633,8 @@ let mk_symbol_seq ?(default= []) ~symbols ~eq ?(deprecated= []) ~long ?short ?pa
~default_to_string:(fun syms -> String.concat ~sep:" " (List.map ~f:to_string syms))
~mk_setter:(fun var str_seq -> var := List.map ~f:of_string (String.split ~on:',' str_seq))
~decode_json:(fun ~inferconfig_dir:_ json ->
[dashdash long; String.concat ~sep:"," (YBU.convert_each YBU.to_string json)]) ~mk_spec:
(fun set -> String set )
[dashdash long; String.concat ~sep:"," (YBU.convert_each YBU.to_string json)] )
~mk_spec:(fun set -> String set)
let mk_set_from_json ~default ~default_to_string ~f ?(deprecated= []) ~long ?short ?parse_mode
@ -772,12 +786,14 @@ let mk_subcommand command ?on_unknown_arg:(on_unknown = `Reject) ~name ?deprecat
( match deprecated_long with
| Some long ->
ignore
(mk ~long ~default:() ?parse_mode ?in_help ~meta:"" "" ~default_to_string:(fun () -> "")
(mk ~long ~default:() ?parse_mode ?in_help ~meta:"" ""
~default_to_string:(fun () -> "")
~decode_json:(fun ~inferconfig_dir:_ _ ->
raise (Arg.Bad ("Bad option in config file: " ^ long)) )
~mk_setter:(fun _ _ ->
warnf "WARNING: '%s' is deprecated. Please use '%s' instead.@\n" (dashdash long) name ;
switch ()) ~mk_spec:(fun set -> Unit (fun () -> set "") ))
switch () )
~mk_spec:(fun set -> Unit (fun () -> set "")))
| None ->
() ) ;
subcommands := (command, (command_doc, name, in_help)) :: !subcommands ;
@ -1008,8 +1024,8 @@ let wrap_line indent_string wrap_length line0 =
let add_word_to_paragraph (rev_lines, non_empty, line, line_length) word =
let word_length =
let len = String.length word in
if String.is_prefix ~prefix:"$(b," word || String.is_prefix ~prefix:"$(i," word then len - 4
(* length of formatting tag prefix *)
if String.is_prefix ~prefix:"$(b," word || String.is_prefix ~prefix:"$(i," word then
len - 4 (* length of formatting tag prefix *)
- 1 (* APPROXIMATION: closing parenthesis that will come after the word, or maybe later *)
else len
in
@ -1059,8 +1075,9 @@ let show_manual ?internal_section format default_doc command_opt =
(* base indentation of documentation strings *)
in
`I (Format.asprintf "$(b,%s)%a%a" (dashdash long) pp_short short pp_meta meta, doc_first_line)
:: List.concat_map (List.concat_map ~f:(wrap_line indent_string width) doc_other_lines) ~f:
(fun s -> [`Noblank; `Pre s] )
:: List.concat_map
(List.concat_map ~f:(wrap_line indent_string width) doc_other_lines)
~f:(fun s -> [`Noblank; `Pre s])
in
let option_blocks =
match command_doc.manual_options with
@ -1098,4 +1115,3 @@ let show_manual ?internal_section format default_doc command_opt =
in
Cmdliner.Manpage.print format Format.std_formatter (command_doc.title, blocks) ;
()

@ -667,7 +667,7 @@ and analyzer =
- $(b,compile): similar to specifying the $(b,compile) subcommand (DEPRECATED)
- $(b,crashcontext): experimental (see $(b,--crashcontext))|}
~f:(function
| CaptureOnly | CompileOnly as x ->
| (CaptureOnly | CompileOnly) as x ->
let analyzer_str =
List.find_map_exn string_to_analyzer ~f:(fun (s, y) ->
if equal_analyzer x y then Some s else None )
@ -774,8 +774,7 @@ and ( annotation_reachability
|> String.concat ~sep:", " ) )
~f:(fun b ->
List.iter
~f:(fun (var, _, _, default) ->
var := if b then default || !var else not default && !var)
~f:(fun (var, _, _, default) -> var := if b then default || !var else not default && !var)
!all_checkers ;
b )
[] (* do all the work in ~f *)
@ -1728,10 +1727,12 @@ and report_previous =
and rest =
CLOpt.mk_rest_actions ~in_help:CLOpt.([(Capture, manual_generic); (Run, manual_generic)])
CLOpt.mk_rest_actions
~in_help:CLOpt.([(Capture, manual_generic); (Run, manual_generic)])
"Stop argument processing, use remaining arguments as a build command" ~usage:exe_usage
(fun build_exe ->
match Filename.basename build_exe with "java" | "javac" -> CLOpt.Javac | _ -> CLOpt.NoParse )
match Filename.basename build_exe with "java" | "javac" -> CLOpt.Javac | _ -> CLOpt.NoParse
)
and results_dir =
@ -2093,7 +2094,7 @@ let post_parsing_initialization command_opt =
match inferconfig_file with
| Some inferconfig ->
Printf.sprintf "version %s/inferconfig %s" Version.commit
(Digest.to_hex (Digest.file inferconfig))
(Caml.Digest.to_hex (Caml.Digest.file inferconfig))
| None ->
Version.commit
in

@ -164,7 +164,7 @@ let update_file_with_lock dir fname update =
let buf = read_whole_file fd in
reset_file fd ;
let str = update buf in
let i = Unix.write fd ~buf:str ~pos:0 ~len:(String.length str) in
let i = Unix.write fd ~buf:(Bytes.of_string str) ~pos:0 ~len:(String.length str) in
if Int.equal i (String.length str) then (
Unix.lockf fd ~mode:Unix.F_ULOCK ~len:0L ;
Unix.close fd )
@ -265,7 +265,6 @@ module Results_dir = struct
in
let full_fname = Filename.concat (create dir_path) filename in
Unix.openfile full_fname ~mode:Unix.([O_WRONLY; O_CREAT; O_TRUNC]) ~perm:0o777
end
let global_tenv_fname =
@ -304,7 +303,8 @@ let fold_paths_matching ~dir ~p ~init ~f =
Array.fold
~f:(fun acc file ->
let path = dir ^/ file in
if Sys.is_directory path = `Yes then paths acc path else if p path then f path acc else acc)
if Sys.is_directory path = `Yes then paths acc path else if p path then f path acc else acc
)
~init:path_list (Sys.readdir dir)
in
paths init dir

@ -50,4 +50,3 @@ let exit_code_of_exception = function
exitcode
| _ ->
(* exit code 2 is used by the OCaml runtime in cases of uncaught exceptions *) 2

@ -36,4 +36,3 @@ let register ~f desc =
Pervasives.at_exit f_no_exn ;
(* Register signal masking. *)
Lazy.force activate_run_epilogues_on_signal

@ -70,7 +70,6 @@ end = struct
let new_id = generate () in
Unix.putenv ~key:infer_run_identifier_env_var ~data:new_id ;
new_id
end
let get_log_identifier () = Random_id.get ()

@ -37,7 +37,6 @@ end = struct
; wrap_bold= wrap_simple
; pp_bold= pp_simple
; bold_to_string= Fn.id }
end
module PhabricatorFormatter : sig
@ -72,7 +71,6 @@ end = struct
; wrap_bold
; pp_bold
; bold_to_string }
end
let formatter =

@ -78,4 +78,3 @@ let merge_buck_flavors_results infer_deps_file =
List.iter ~f:one_line lines
| Error error ->
L.internal_error "Couldn't read deps file '%s': %s" infer_deps_file error

@ -64,4 +64,3 @@ let resolve fname =
fname
| Some links ->
try DB.filename_from_string (String.Table.find_exn links base) with Not_found -> fname

@ -63,7 +63,8 @@ let text =
(** Default html print environment *)
let html color =
{ text with
kind= HTML; cmap_norm= colormap_from_color color; cmap_foot= colormap_from_color color; color }
kind= HTML; cmap_norm= colormap_from_color color; cmap_foot= colormap_from_color color; color
}
(** Extend the normal colormap for the given object with the given color *)
@ -146,4 +147,3 @@ let pp_argfile fmt fname =
let cli_args fmt args =
F.fprintf fmt "'%a'@\n%a" (seq ~sep:"' '" string) args (seq ~sep:"\n" pp_argfile)
(List.filter_map ~f:(String.chop_prefix ~prefix:"@") args)

@ -63,5 +63,4 @@ module MakePPMap (Ord : PrintableOrderedType) = struct
let pp ~pp_value fmt m =
let pp_item fmt (k, v) = F.fprintf fmt "%a -> %a" Ord.pp k pp_value v in
pp_collection ~pp_item fmt (bindings m)
end

@ -65,4 +65,3 @@ let pipeline ~producer_prog ~producer_args ~consumer_prog ~consumer_args =
let producer_status = Unix.waitpid producer_pid in
let consumer_status = Unix.waitpid consumer_pid in
(producer_status, consumer_status)

@ -45,4 +45,3 @@ let start_child ~f ~pool x =
| `In_the_parent _pid ->
incr pool ;
if should_wait pool then wait pool

@ -34,7 +34,6 @@ module Key = struct
, 579094948
, 972393003
, 852343110 )
end
(** version of the binary files, to be incremented for each change *)
@ -95,7 +94,8 @@ let create_serializer (key: Key.t) : 'a serializer =
(* Retry to read for 1 second in case of end of file, *)
(* which indicates that another process is writing the same file. *)
let one_second = Mtime.Span.of_uint64_ns (Int64.of_int 1_000_000_000) in
SymOp.try_finally ~f:(fun () -> retry_exception ~timeout:one_second ~catch_exn ~f:read ())
SymOp.try_finally
~f:(fun () -> retry_exception ~timeout:one_second ~catch_exn ~f:read ())
~finally:(fun () -> In_channel.close inc)
in
let write_to_tmp_file fname data =

@ -179,5 +179,4 @@ module SQLite = struct
RelativeProjectRoot rel_path
| Sqlite3.Data.BLOB b ->
Marshal.from_string b 0
end

@ -69,4 +69,3 @@ let compute_statistics values =
; p75= percentile 0.75
; max= percentile 1.0
; count= num_elements }

@ -185,7 +185,7 @@ let directory_iter f path =
let directory_is_empty path = Sys.readdir path |> Array.is_empty
let string_crc_hex32 s = Digest.to_hex (Digest.string s)
let string_crc_hex32 s = Caml.Digest.to_hex (Caml.Digest.string s)
let read_json_file path =
try Ok (Yojson.Basic.from_file path) with Sys_error msg | Yojson.Json_error msg -> Error msg
@ -245,8 +245,8 @@ let shell_escape_command =
| arg ->
if Str.string_match no_quote_needed arg 0 then arg
else if Str.string_match easy_single_quotable arg 0 then F.sprintf "'%s'" arg
else if Str.string_match easy_double_quotable arg 0 then arg |> Escape.escape_double_quotes
|> F.sprintf "\"%s\""
else if Str.string_match easy_double_quotable arg 0 then
arg |> Escape.escape_double_quotes |> F.sprintf "\"%s\""
else
(* ends on-going single quote, output single quote inside double quotes, then open a new single
quote *)
@ -338,7 +338,10 @@ let compare_versions v1 v2 =
let write_file_with_locking ?(delete= false) ~f:do_write fname =
Unix.with_file ~mode:Unix.([O_WRONLY; O_CREAT]) fname ~f:(fun file_descr ->
Unix.with_file
~mode:Unix.([O_WRONLY; O_CREAT])
fname
~f:(fun file_descr ->
if Unix.flock file_descr Unix.Flock_command.lock_exclusive then (
(* make sure we're not writing over some existing, possibly longer content: some other
process may have snagged the file from under us between open(2) and flock(2) so passing
@ -387,4 +390,4 @@ let yield () =
Unix.select ~read:[] ~write:[] ~except:[] ~timeout:(`After Time_ns.Span.min_value) |> ignore
let better_hash x = Marshal.to_string x [Marshal.No_sharing] |> Digest.string
let better_hash x = Marshal.to_string x [Marshal.No_sharing] |> Caml.Digest.string

Some files were not shown because too many files have changed in this diff Show More

Loading…
Cancel
Save