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

[BetterEngineering] Remove remaining uses of polymorphic equality

Browse Source 
Summary:
Remove the remaining uses of polymorphic equality `=`.
In case of basic types, this is replaced by String.equal or Int.equal.
In case of `= []`, this is replaced by `List.is_empty`.
In case of `= None`, this is replaced by `is_none`.
In case of a datatype definition such as `type a = A | B`,
a `compare_a` function is defined by adding `type a = A | B [@deriving compare]`
and a `equal_a` function is defined as `let equal_a = [%compare.equal : a]`.
In case of comparison with a polymorphic variant `= `Yes`, the equality
defined in `PVariant.(=)` is used. Typically, `open! Pvariant` is added
at the beginning of the file to cover all the uses.

Reviewed By: jberdine

Differential Revision: D4456129

fbshipit-source-id: f31c433
master
Cristiano Calcagno 8 years ago committed by Facebook Github Bot
parent bd2110a789
commit b1421bc27f
62 changed files with 274 additions and 220 deletions
Show Stats Download Patch File Download Diff File

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

@ -28,6 +28,8 @@ type access =
| Protected
[@@deriving compare];
let equal_access = [%compare.equal : access];
/** Return the value of the FA_sentinel attribute in [attr_list] if it is found */
let get_sentinel_func_attribute_value attr_list =>

2
infer/src/IR/PredSymb.rei
Unescape View File

@ -34,6 +34,8 @@ type access =
| Protected
[@@deriving compare];
let equal_access: access => access => bool;
type mem_kind =
| Mmalloc /** memory allocated with malloc */
| Mnew /** memory allocated with new */

7
infer/src/IR/Procdesc.re
Unescape View File

@ -17,7 +17,8 @@ let module F = Format;
/* =============== START of module Node =============== */
let module Node = {
type id = int;
type id = int [@@deriving compare];
let equal_id = [%compare.equal : id];
type nodekind =
| Start_node Procname.t
| Exit_node Procname.t
@ -26,6 +27,7 @@ let module Node = {
| Prune_node bool Sil.if_kind string /** (true/false branch, if_kind, comment) */
| Skip_node string
[@@deriving compare];
let equal_nodekind = [%compare.equal : nodekind];
/** a node */
type t = {
@ -68,9 +70,6 @@ let module Node = {
/** Get the unique id of the node */
let get_id node => node.id;
/** compare node ids */
let compare_id = Int.compare;
let get_succs node => node.succs;
type node = t;
let module NodeSet = Caml.Set.Make {

2
infer/src/IR/Procdesc.rei
Unescape View File

@ -18,6 +18,7 @@ let module Node: {
/** node id */
type id = private int [@@deriving compare];
let equal_id: id => id => bool;
/** kind of cfg node */
type nodekind =
@ -28,6 +29,7 @@ let module Node: {
| Prune_node bool Sil.if_kind string /** (true/false branch, if_kind, comment) */
| Skip_node string
[@@deriving compare];
let equal_nodekind: nodekind => nodekind => bool;
/** kind of Stmt_node for an exception handler. */
let exn_handler_kind: nodekind;

8
infer/src/IR/Sil.re
Unescape View File

@ -2094,7 +2094,7 @@ let compare_structural_instr instr1 instr2 exp_map => {
}
};
let id_list_compare_structural ids1 ids2 exp_map => {
let n = Pervasives.compare (IList.length ids1) (IList.length ids2);
let n = Int.compare (IList.length ids1) (IList.length ids2);
if (n != 0) {
(n, exp_map)
} else {
@ -2150,14 +2150,14 @@ let compare_structural_instr instr1 instr2 exp_map => {
if (n != 0) {
n
} else {
Pervasives.compare ik1 ik2
compare_if_kind ik1 ik2
}
},
exp_map
)
| (Call ret_id1 e1 arg_ts1 _ cf1, Call ret_id2 e2 arg_ts2 _ cf2) =>
let args_compare_structural args1 args2 exp_map => {
let n = Pervasives.compare (IList.length args1) (IList.length args2);
let n = Int.compare (IList.length args1) (IList.length args2);
if (n != 0) {
(n, exp_map)
} else {
@ -2199,7 +2199,7 @@ let compare_structural_instr instr1 instr2 exp_map => {
| (Remove_temps temps1 _, Remove_temps temps2 _) =>
id_list_compare_structural temps1 temps2 exp_map
| (Declare_locals ptl1 _, Declare_locals ptl2 _) =>
let n = Pervasives.compare (IList.length ptl1) (IList.length ptl2);
let n = Int.compare (IList.length ptl1) (IList.length ptl2);
if (n != 0) {
(n, exp_map)
} else {

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

@ -108,6 +108,8 @@ type ptr_kind =
| Pk_objc_autoreleasing /** Obj-C __autoreleasing pointer */
[@@deriving compare];
let equal_ptr_kind = [%compare.equal : ptr_kind];
let ptr_kind_string =
fun
| Pk_reference => "&"

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

@ -63,6 +63,8 @@ type ptr_kind =
| Pk_objc_autoreleasing /** Obj-C __autoreleasing pointer */
[@@deriving compare];
let equal_ptr_kind: ptr_kind => ptr_kind => bool;
/** statically determined length of an array type, if any */
type static_length = option IntLit.t [@@deriving compare];

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

@ -699,7 +699,7 @@ let _execute_free_nonzero mk pdesc tenv instr prop lexp typ loc =
IList.rev prop_list
end
with Rearrange.ARRAY_ACCESS ->
if (Config.array_level = 0) then assert false
if (Int.equal Config.array_level 0) then assert false
else begin
L.d_strln ".... Array containing allocated heap cells ....";
L.d_str " Instr: "; Sil.d_instr instr; L.d_ln ();
@ -929,8 +929,8 @@ let execute___infer_fail { Builtin.pdesc; tenv; prop_; path; args; loc; }
let execute___assert_fail { Builtin.pdesc; tenv; prop_; path; args; loc; }
: Builtin.ret_typ =
let error_str =
match args with
| l when IList.length l = 4 ->
match IList.length args with
| 4 ->
Config.default_failure_name
| _ ->
raise (Exceptions.Wrong_argument_number __POS__) in

12
infer/src/backend/dom.ml
Unescape View File

@ -251,7 +251,7 @@ module CheckJoinPre : InfoLossCheckerSig = struct
| Exp.Lvar _ -> false
| Exp.Var id when Ident.is_normal id -> IList.length es >= 1
| Exp.Var _ ->
if Config.join_cond = 0 then
if Int.equal Config.join_cond 0 then
IList.exists (Exp.equal Exp.zero) es
else if Dangling.check side e then
begin
@ -989,7 +989,7 @@ and dynamic_length_partial_join l1 l2 =
option_partial_join (fun len1 len2 -> Some (length_partial_join len1 len2)) l1 l2
and typ_partial_join t1 t2 = match t1, t2 with
| Typ.Tptr (t1, pk1), Typ.Tptr (t2, pk2) when Typ.compare_ptr_kind pk1 pk2 = 0 ->
| Typ.Tptr (t1, pk1), Typ.Tptr (t2, pk2) when Typ.equal_ptr_kind pk1 pk2 ->
Typ.Tptr (typ_partial_join t1 t2, pk1)
| Typ.Tarray (typ1, len1), Typ.Tarray (typ2, len2) ->
let t = typ_partial_join typ1 typ2 in
@ -1069,7 +1069,7 @@ let rec strexp_partial_join mode (strexp1: Sil.strexp) (strexp2: Sil.strexp) : S
end
| (fld1, se1):: fld_se_list1', (fld2, se2):: fld_se_list2' ->
let comparison = Ident.compare_fieldname fld1 fld2 in
if comparison = 0 then
if Int.equal comparison 0 then
let strexp' = strexp_partial_join mode se1 se2 in
let fld_se_list_new = (fld1, strexp') :: acc in
f_fld_se_list inst mode fld_se_list_new fld_se_list1' fld_se_list2'
@ -1633,7 +1633,7 @@ let pi_partial_join tenv mode
match Rename.get_other_atoms tenv side a with
| None -> None
| Some (a_res, a_op) ->
if mode = JoinState.Pre then join_atom_check_pre p_op a_op;
if JoinState.equal_mode mode JoinState.Pre then join_atom_check_pre p_op a_op;
if Attribute.is_pred a then join_atom_check_attribute p_op a_op;
if not (Prover.check_atom tenv p_op a_op) then None
else begin
@ -1756,7 +1756,7 @@ let eprop_partial_join' tenv mode (ep1: Prop.exposed Prop.t) (ep2: Prop.exposed
let es1 = sigma_get_start_lexps_sort sigma1 in
let es2 = sigma_get_start_lexps_sort sigma2 in
let simple_check = IList.length es1 = IList.length es2 in
let simple_check = Int.equal (IList.length es1) (IList.length es2) in
let rec expensive_check es1' es2' =
match (es1', es2') with
| [], [] -> true
@ -2017,7 +2017,7 @@ let proplist_meet_generate tenv plist =
let propset_meet_generate_pre tenv pset =
let plist = Propset.to_proplist pset in
if Config.meet_level = 0 then plist
if Int.equal Config.meet_level 0 then plist
else
let pset1 = proplist_meet_generate tenv plist in
let pset_new = Propset.diff pset1 pset in

21
infer/src/backend/interproc.ml
Unescape View File

@ -9,6 +9,8 @@
*)
open! IStd
open! PVariant
module Hashtbl = Caml.Hashtbl
(** Interprocedural Analysis *)
@ -529,7 +531,7 @@ let forward_tabulate tenv pdesc wl source =
let log_string proc_name =
let summary = Specs.get_summary_unsafe "forward_tabulate" proc_name in
let phase_string =
if Specs.get_phase summary = Specs.FOOTPRINT then "FP" else "RE" in
if Specs.equal_phase (Specs.get_phase summary) Specs.FOOTPRINT then "FP" else "RE" in
let timestamp = Specs.get_timestamp summary in
F.sprintf "[%s:%d] %s" phase_string timestamp (Procname.to_string proc_name) in
L.d_strln ("**** " ^ (log_string pname) ^ " " ^
@ -1174,14 +1176,14 @@ let is_unavoidable tenv pre =
let report_runtime_exceptions tenv pdesc summary =
let pname = Specs.get_proc_name summary in
let is_public_method =
(Specs.get_attributes summary).ProcAttributes.access = PredSymb.Public in
PredSymb.equal_access (Specs.get_attributes summary).access PredSymb.Public in
let is_main =
is_public_method
&&
(match pname with
| Procname.Java pname_java ->
Procname.java_is_static pname
&& (Procname.java_get_method pname_java) = "main"
&& String.equal (Procname.java_get_method pname_java) "main"
| _ ->
false) in
let is_annotated =
@ -1235,7 +1237,7 @@ let update_specs tenv proc_name phase (new_specs : Specs.NormSpec.t list)
(Paths.PathSet.from_renamed_list spec.Specs.posts, spec.Specs.visited) map)
SpecMap.empty old_specs) in
let re_exe_filter old_spec = (* filter out pres which failed re-exe *)
if phase = Specs.RE_EXECUTION &&
if Specs.equal_phase phase Specs.RE_EXECUTION &&
not (IList.exists
(fun new_spec -> Specs.Jprop.equal new_spec.Specs.pre old_spec.Specs.pre)
new_specs)
@ -1395,7 +1397,7 @@ let perform_transition exe_env tenv proc_name source =
[] in
transition_footprint_re_exe tenv proc_name joined_pres in
match Specs.get_summary proc_name with
| Some summary when Specs.get_phase summary = Specs.FOOTPRINT ->
| Some summary when Specs.equal_phase (Specs.get_phase summary) Specs.FOOTPRINT ->
transition ()
| _ -> ()
@ -1404,7 +1406,7 @@ let interprocedural_algorithm exe_env : unit =
let call_graph = Exe_env.get_cg exe_env in
let filter_initial proc_name =
let summary = Specs.get_summary_unsafe "main_algorithm" proc_name in
Specs.get_timestamp summary = 0 in
Int.equal (Specs.get_timestamp summary) 0 in
let procs_to_analyze =
IList.filter filter_initial (Cg.get_defined_nodes call_graph) in
let to_analyze proc_name =
@ -1461,7 +1463,7 @@ let do_analysis exe_env =
(fun ((pn, _) as x) ->
let should_init () =
Config.models_mode ||
Specs.get_summary pn = None in
is_none (Specs.get_summary pn) in
if should_init ()
then init_proc x)
procs_and_defined_children;
@ -1547,7 +1549,7 @@ let print_stats_cfg proc_shadowed source cfg =
let compute_stats_proc proc_desc =
let proc_name = Procdesc.get_proc_name proc_desc in
if proc_shadowed proc_desc ||
Specs.get_summary proc_name = None then
is_none (Specs.get_summary proc_name) then
L.out "print_stats: ignoring function %a which is also defined in another file@."
Procname.pp proc_name
else
@ -1560,7 +1562,8 @@ let print_stats_cfg proc_shadowed source cfg =
let () =
match specs,
Errlog.size
(fun ekind in_footprint -> ekind = Exceptions.Kerror && in_footprint)
(fun ekind in_footprint ->
Exceptions.equal_err_kind ekind Exceptions.Kerror && in_footprint)
err_log with
| [], 0 -> incr num_nospec_noerror_proc
| _, 0 -> incr num_spec_noerror_proc

3
infer/src/backend/joinState.ml
Unescape View File

@ -14,6 +14,9 @@ open! IStd
type mode =
| Pre
| Post
[@@deriving compare]
let equal_mode = [%compare.equal : mode]
(** set to true when we are doing join of footprints *)
let footprint = ref false

3
infer/src/backend/joinState.mli
Unescape View File

@ -14,6 +14,9 @@ open! IStd
type mode =
| Pre
| Post
[@@deriving compare]
val equal_mode : mode -> mode -> bool
val get_footprint : unit -> bool
val set_footprint : bool -> unit

2
infer/src/backend/specs.mli
Unescape View File

@ -119,6 +119,8 @@ type status = ACTIVE | INACTIVE | STALE
type phase = FOOTPRINT | RE_EXECUTION
val equal_phase : phase -> phase -> bool
type dependency_map_t = int Procname.Map.t
type call_summary = CallSite.Set.t Annot.Map.t

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

@ -52,7 +52,7 @@ module IntSet = Caml.Set.Make(Int)
(* Compare police: generic compare mostly disabled. *)
let compare = No_polymorphic_compare.compare
let equal = No_polymorphic_compare.equal
(* let (=) = equal *)
let (=) = No_polymorphic_compare.(=)
module PVariant = struct
(* Equality for polymorphic variants *)

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

@ -124,7 +124,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
| Procname.C _ -> true (* Needed for test code. *)
| Procname.Block _ | Procname.Linters_dummy_method ->
failwith "Proc type not supported by crashcontext: block" in
frame.Stacktrace.method_str = (Procname.get_method caller) &&
String.equal frame.Stacktrace.method_str (Procname.get_method caller) &&
matches_class caller in
let all_frames = IList.flatten
(IList.map (fun trace -> trace.Stacktrace.frames) traces) in

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

@ -95,7 +95,7 @@ module Make (Spec : Spec) : S = struct
(* should never fail since keys in the invariant map should always be real node id's *)
let node =
IList.find
(fun node -> Procdesc.Node.compare_id node_id (Procdesc.Node.get_id node) = 0)
(fun node -> Procdesc.Node.equal_id node_id (Procdesc.Node.get_id node))
nodes in
Domain.iter
(fun astate ->

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

@ -388,7 +388,9 @@ let is_immutable_collection_class class_name tenv =
"com.google.common.collect.ImmutableTable";
] in
PatternMatch.supertype_exists
tenv (fun typename _ -> IList.mem (=) (Typename.name typename) immutable_collections) class_name
tenv
(fun typename _ -> IList.mem String.equal (Typename.name typename) immutable_collections)
class_name
let is_call_to_builder_class_method = function
| Procname.Java java_pname -> is_builder_class (Procname.java_get_class_name java_pname)
@ -560,7 +562,7 @@ let should_report_on_file file_env =
fun (_, tenv, pname, _) ->
match get_current_class_and_threadsafe_superclasses tenv pname with
| Some (_, thread_safe_annotated_classes) ->
not (thread_safe_annotated_classes = [])
not (List.is_empty thread_safe_annotated_classes)
| _ -> false
in
let current_class_marked_not_threadsafe =

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

@ -49,7 +49,7 @@ module PathDomain = SinkTrace.Make(TraceElem)
module IntMap = PrettyPrintable.MakePPMap(struct
type t = int
let compare = Pervasives.compare
let compare = Int.compare
let pp_key fmt = F.fprintf fmt "%d"
end)

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

@ -288,7 +288,7 @@ module Make (Spec : Spec) = struct
(fun passthrough1 passthrough2 ->
let loc1 = CallSite.loc (Passthrough.site passthrough1) in
let loc2 = CallSite.loc (Passthrough.site passthrough2) in
Pervasives.compare loc1.Location.line loc2.Location.line)
Int.compare loc1.Location.line loc2.Location.line)
(Passthroughs.elements passthroughs) in
IList.fold_right trace_elem_of_passthrough sorted_passthroughs acc0 in

10
infer/src/checkers/annotationReachability.ml
Unescape View File

@ -194,7 +194,7 @@ let report_allocation_stack
Reporting.log_error pname ~loc:fst_call_loc ~ltr:final_trace exn
let report_annotation_stack src_annot snk_annot src_pname loc trace stack_str snk_pname call_loc =
if snk_annot = dummy_constructor_annot
if String.equal snk_annot dummy_constructor_annot
then report_allocation_stack src_annot src_pname loc trace stack_str snk_pname call_loc
else
let final_trace = IList.rev (update_trace call_loc trace) in
@ -209,7 +209,7 @@ let report_annotation_stack src_annot snk_annot src_pname loc trace stack_str sn
exp_pname_str
snk_annot in
let msg =
if src_annot = Annotations.performance_critical
if String.equal src_annot Annotations.performance_critical
then calls_expensive_method
else annotation_reachability_error in
let exn =
@ -259,7 +259,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
let is_unlikely pname =
match pname with
| Procname.Java java_pname ->
(Procname.java_get_method java_pname) = "unlikely"
String.equal (Procname.java_get_method java_pname) "unlikely"
| _ -> false
let is_tracking_exp astate = function
@ -283,7 +283,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
(* TODO: generalize this to allow sanitizers for other annotation types, store it in [extras] so
we can compute it just once *)
let method_is_sanitizer annot tenv pname =
if annot.Annot.class_name = dummy_constructor_annot
if String.equal annot.Annot.class_name dummy_constructor_annot
then method_has_ignore_allocation_annot tenv pname
else false
@ -393,7 +393,7 @@ module Interprocedural = struct
(CallSite.make proc_name loc)
calls in
let calls = extract_calls_with_annot snk_annot call_map in
if not (IList.length calls = 0)
if not (Int.equal (IList.length calls) 0)
then IList.iter (report_src_snk_path calls) src_annot_list in
let initial =

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

@ -83,7 +83,7 @@ let check_final_state tenv proc_name proc_desc final_s =
let description = Format.sprintf "Node not visited: %d" (Procdesc.Node.get_id n :> int) in
let report = match Procdesc.Node.get_kind n with
| Procdesc.Node.Join_node -> false
| k when k = Procdesc.Node.exn_sink_kind -> false
| k when Procdesc.Node.equal_nodekind k Procdesc.Node.exn_sink_kind -> false
| _ -> true in
if report
then report_error tenv description proc_name proc_desc loc in

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

@ -47,13 +47,13 @@ module APIs = struct
let method_match pn pkgname cname mname =
match pn with
| Procname.Java pn_java ->
Procname.java_get_method pn_java = mname
String.equal (Procname.java_get_method pn_java) mname
&&
(match pkgname with
| "" ->
Procname.java_get_simple_class_name pn_java = cname
String.equal (Procname.java_get_simple_class_name pn_java) cname
| _ ->
Procname.java_get_class_name pn_java = pkgname ^ "." ^ cname)
String.equal (Procname.java_get_class_name pn_java) (pkgname ^ "." ^ cname))
| _ ->
false
let is_begin pn =
@ -113,11 +113,11 @@ module State = struct
(** State is balanced. *)
let is_balanced s =
ElemSet.for_all (fun elem -> Elem.get_int elem = 0) s
ElemSet.for_all (fun elem -> Int.equal (Elem.get_int elem) 0) s
let equal = ElemSet.equal
let has_zero s = ElemSet.exists (fun elem -> Elem.get_int elem = 0) s
let has_zero s = ElemSet.exists (fun elem -> Int.equal (Elem.get_int elem) 0) s
(** Map a function to the elements of the set, and filter out inconsistencies. *)
let map2 (f : Elem.t -> Elem.t list) (s : t) : t =

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

@ -24,7 +24,7 @@ let callback_fragment_retains_view_java
pname_java { Callbacks.proc_desc; tenv } =
(* TODO: complain if onDestroyView is not defined, yet the Fragment has View fields *)
(* TODO: handle fields nullified in callees in the same file *)
let is_on_destroy_view = Procname.java_get_method pname_java = "onDestroyView" in
let is_on_destroy_view = String.equal (Procname.java_get_method pname_java) "onDestroyView" in
let fld_typ_is_view = function
| Typ.Tptr (Tstruct tname, _) -> AndroidFramework.is_view tenv tname
| _ -> false in

13
infer/src/checkers/repeatedCallsChecker.ml
Unescape View File

@ -56,6 +56,9 @@ struct
type paths =
| AllPaths (** Check on all paths *)
| SomePath (** Check if some path exists *)
[@@deriving compare]
let equal_paths = [%compare.equal : paths]
(** Check if the procedure performs an allocation operation.
If [paths] is AllPaths, check if an allocation happens on all paths.
@ -77,21 +80,21 @@ struct
let module DFAllocCheck = Dataflow.MakeDF(struct
type t = Location.t option [@@deriving compare]
let equal x y = compare x y = 0
let _join _paths l1o l2o = (* join with left priority *)
let equal = [%compare.equal : t]
let join_ paths_ l1o l2o = (* join with left priority *)
match l1o, l2o with
| None, None ->
None
| Some loc, None
| None, Some loc ->
if _paths = AllPaths then None else Some loc
if equal_paths paths_ AllPaths then None else Some loc
| Some loc1, Some _ ->
Some loc1 (* left priority *)
let join = _join paths
let join = join_ paths
let do_node _ node lo1 =
let lo2 = node_allocates node in
let lo' = (* use left priority join to implement transfer function *)
_join SomePath lo1 lo2 in
join_ SomePath lo1 lo2 in
[lo'], [lo']
let proc_throws _ = Dataflow.DontKnow
end) in

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

@ -29,8 +29,8 @@ let callback_sql { Callbacks.proc_desc; proc_name; tenv } =
(* Check for SQL string concatenations *)
let do_instr const_map node instr =
let do_call pn_java i1 i2 l =
if Procname.java_get_class_name pn_java = "java.lang.StringBuilder"
&& Procname.java_get_method pn_java = "append"
if String.equal (Procname.java_get_class_name pn_java) "java.lang.StringBuilder"
&& String.equal (Procname.java_get_method pn_java) "append"
then
begin
let rvar1 = Exp.Var i1 in

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

@ -180,7 +180,7 @@ and get_record_declaration_struct_type tenv decl =
[StructTyp.objc_ref_counter_field]
else [] in
let annots =
if csu = Csu.Class Csu.CPP then Annot.Class.cpp
if Csu.equal csu (Csu.Class Csu.CPP) then Annot.Class.cpp
else Annot.Item.empty (* No annotations for structs *) in
if is_complete_definition then (
CAst_utils.update_sil_types_map type_ptr (Typ.Tstruct sil_typename);

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

@ -158,7 +158,10 @@ let cc1_capture clang_cmd => {
Utils.filename_to_absolute root::root orig_argv.(Array.length orig_argv - 1)
};
Logging.out "@\n*** Beginning capture of file %s ***@\n" source_path;
if (Config.analyzer == Config.Compile || CLocation.is_file_blacklisted source_path) {
if (
Config.equal_analyzer Config.analyzer Config.Compile ||
CLocation.is_file_blacklisted source_path
) {
Logging.out "@\n Skip the analysis of source file %s@\n@\n" source_path;
/* We still need to run clang, but we don't have to attach the plugin. */
run_clang (ClangCommand.command_to_run clang_cmd) Utils.consume_in

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

@ -105,8 +105,8 @@ let exe prog::prog args::args => {
| None => (clang_xx, false)
};
IList.iter exec_action_item commands;
if (commands == [] || should_run_original_command) {
if (commands == []) {
if (List.is_empty commands || should_run_original_command) {
if (List.is_empty commands) {
/* No command to execute after -###, let's execute the original command
instead.

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

@ -8,6 +8,7 @@
*)
open! IStd
open! PVariant
let get_source_range an =
match an with
@ -231,7 +232,7 @@ let component_with_multiple_factory_methods_advice context an =
| ObjCMethodDecl (decl_info, _, _) -> decl_info.Clang_ast_t.di_attributes
| _ -> assert false in
let unavailable_attrs = (IList.filter is_unavailable_attr attrs) in
let is_available = IList.length unavailable_attrs = 0 in
let is_available = Int.equal (IList.length unavailable_attrs) 0 in
(CAst_utils.is_objc_factory_method if_decl decl) && is_available in
let check_interface if_decl =

24
infer/src/clang/cAst_utils.ml
Unescape View File

@ -8,6 +8,7 @@
*)
open! IStd
open! PVariant
(** Functions for transformations of ast nodes *)
@ -105,15 +106,6 @@ let generated_ivar_name property_name =
}
| _ -> make_name_decl property_name.Clang_ast_t.ni_name
let compare_property_attribute =
[%compare: [
`Readonly | `Assign | `Readwrite | `Retain | `Copy | `Nonatomic | `Atomic
| `Weak | `Strong | `Unsafe_unretained | `ExplicitGetter | `ExplicitSetter
]]
let equal_property_attribute att1 att2 =
compare_property_attribute att1 att2 = 0
let get_memory_management_attributes () =
[`Assign; `Retain; `Copy; `Weak; `Strong; `Unsafe_unretained]
@ -235,8 +227,10 @@ let get_decl_from_typ_ptr typ_ptr =
let is_type_nonnull type_ptr =
let open Clang_ast_t in
match get_type type_ptr with
| Some AttributedType (_, attr_info) -> attr_info.ati_attr_kind = `Nonnull
| _ -> false
| Some AttributedType (_, attr_info) ->
attr_info.ati_attr_kind = `Nonnull
| _ ->
false
let is_type_nullable type_ptr =
let open Clang_ast_t in
@ -283,7 +277,7 @@ let get_function_decl_with_body decl_ptr =
| Some (CXXDestructorDecl (_, _, _, fdecl_info, _)) ->
fdecl_info.Clang_ast_t.fdi_decl_ptr_with_body
| _ -> Some decl_ptr in
if decl_ptr' = (Some decl_ptr) then decl_opt
if [%compare.equal : int option] decl_ptr' (Some decl_ptr) then decl_opt
else get_decl_opt decl_ptr'
let get_info_from_decl_ref decl_ref =
@ -317,7 +311,7 @@ let is_ptr_to_objc_class typ class_name =
| Some ObjCInterfaceType (_, ptr) ->
(match get_decl ptr with
| Some ObjCInterfaceDecl (_, ndi, _, _, _) ->
String.compare ndi.ni_name class_name = 0
String.equal ndi.ni_name class_name
| _ -> false)
| _ -> false)
| _ -> false
@ -442,7 +436,7 @@ let if_decl_to_di_pointer_opt if_decl =
let is_instance_type type_ptr =
match name_opt_of_typedef_type_ptr type_ptr with
| Some name -> name = "instancetype"
| Some name -> String.equal name "instancetype"
| None -> false
let return_type_matches_class_type rtp type_decl_pointer =
@ -452,7 +446,7 @@ let return_type_matches_class_type rtp type_decl_pointer =
let return_type_decl_opt = type_ptr_to_objc_interface rtp in
let return_type_decl_pointer_opt =
Option.map ~f:if_decl_to_di_pointer_opt return_type_decl_opt in
(Some type_decl_pointer) = return_type_decl_pointer_opt
[%compare.equal : int option option] (Some type_decl_pointer) return_type_decl_pointer_opt
let is_objc_factory_method if_decl meth_decl =
let if_type_decl_pointer = if_decl_to_di_pointer_opt if_decl in

6
infer/src/clang/cAst_utils.mli
Unescape View File

@ -23,15 +23,9 @@ val name_opt_of_name_info_opt : Clang_ast_t.named_decl_info option -> string opt
val property_name : Clang_ast_t.obj_c_property_impl_decl_info -> Clang_ast_t.named_decl_info
val compare_property_attribute :
Clang_ast_t.property_attribute -> Clang_ast_t.property_attribute -> int
val generated_ivar_name :
Clang_ast_t.named_decl_info -> Clang_ast_t.named_decl_info
val equal_property_attribute :
Clang_ast_t.property_attribute -> Clang_ast_t.property_attribute -> bool
val get_memory_management_attributes : unit -> Clang_ast_t.property_attribute list
val is_retain : Clang_ast_t.property_attribute option -> bool

3
infer/src/clang/cContext.ml
Unescape View File

@ -32,8 +32,7 @@ type curr_class =
| ContextNoCls
[@@deriving compare]
let equal_curr_class curr_class1 curr_class2 =
compare_curr_class curr_class1 curr_class2 = 0
let equal_curr_class = [%compare.equal : curr_class]
type str_node_map = (string, Procdesc.Node.t) Hashtbl.t

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

@ -92,7 +92,7 @@ let modelled_fields_in_classes =
let modelled_field class_name_info =
let modelled_field_in_class res (class_name, field_name, typ) =
if class_name = class_name_info.Clang_ast_t.ni_name then
if String.equal class_name class_name_info.Clang_ast_t.ni_name then
let class_name_qualified = class_name_info.Clang_ast_t.ni_qual_name in
let field_name_qualified = CAst_utils.make_qual_name_decl class_name_qualified field_name in
let name = CGeneral_utils.mk_class_field_name field_name_qualified in

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

@ -11,7 +11,9 @@ open! IStd
(** Module that contains constants and global state used in the frontend *)
type clang_lang = C | CPP | ObjC | ObjCPP
type clang_lang = C | CPP | ObjC | ObjCPP [@@deriving compare]
let equal_clang_lang = [%compare.equal : clang_lang]
type translation_unit_context = {
lang : clang_lang;

4
infer/src/clang/cFrontend_config.mli
Unescape View File

@ -11,7 +11,9 @@ open! IStd
(** Module that contains constants and global state used in the frontend *)
type clang_lang = C | CPP | ObjC | ObjCPP
type clang_lang = C | CPP | ObjC | ObjCPP [@@deriving compare]
val equal_clang_lang : clang_lang -> clang_lang -> bool
type translation_unit_context = {
lang : clang_lang;

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

@ -135,7 +135,7 @@ let expand_checkers checkers =
match acc with
| True
| False -> acc
| Atomic (name, [p]) when formula_id_const = p ->
| Atomic (name, [p]) when String.equal formula_id_const p ->
Logging.out " -Expanding formula identifier '%s'\n" name;
(match Core.Std.String.Map.find map name with
| Some f1 -> expand f1 map

12
infer/src/clang/cGeneral_utils.ml
Unescape View File

@ -44,7 +44,7 @@ let append_no_duplicates_methods list1 list2 =
append_no_duplicates Procname.equal list1 list2
let append_no_duplicates_annotations list1 list2 =
let eq (annot1, _) (annot2, _) = annot1.Annot.class_name = annot2.Annot.class_name in
let eq (annot1, _) (annot2, _) = String.equal annot1.Annot.class_name annot2.Annot.class_name in
append_no_duplicates eq list1 list2
let add_no_duplicates_fields field_tuple l =
@ -86,7 +86,7 @@ let rec collect_list_tuples l (a, a1, b, c, d) =
let is_static_var var_decl_info =
match var_decl_info.Clang_ast_t.vdi_storage_class with
| Some sc -> sc = CFrontend_config.static
| Some sc -> String.equal sc CFrontend_config.static
| _ -> false
let block_procname_with_index defining_proc i =
@ -139,11 +139,13 @@ let mk_class_field_name field_qual_name =
let is_cpp_translation translation_unit_context =
let lang = translation_unit_context.CFrontend_config.lang in
lang = CFrontend_config.CPP || lang = CFrontend_config.ObjCPP
CFrontend_config.equal_clang_lang lang CFrontend_config.CPP ||
CFrontend_config.equal_clang_lang lang CFrontend_config.ObjCPP
let is_objc_extension translation_unit_context =
let lang = translation_unit_context.CFrontend_config.lang in
lang = CFrontend_config.ObjC || lang = CFrontend_config.ObjCPP
CFrontend_config.equal_clang_lang lang CFrontend_config.ObjC ||
CFrontend_config.equal_clang_lang lang CFrontend_config.ObjCPP
let rec get_mangled_method_name function_decl_info method_decl_info =
(* For virtual methods return mangled name of the method from most base class
@ -183,7 +185,7 @@ let mk_procname_from_function translation_unit_context name function_decl_info_o
| Some m when is_cpp_translation translation_unit_context -> m
| _ -> "" in
let mangled = (Utils.string_crc_hex32 file) ^ mangled_name in
if String.length file = 0 && String.length mangled_name = 0 then
if String.is_empty file && String.is_empty mangled_name then
Procname.from_string_c_fun name
else
Procname.C (Procname.c name mangled)

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

@ -8,6 +8,7 @@
*)
open! IStd
open! PVariant
(** Module for function to retrieve the location (file, line, etc) of instructions *)

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

@ -66,13 +66,13 @@ let ms_get_return_param_typ { return_param_typ } =
(* it has 1 argument (this includes self) *)
let ms_is_getter { pointer_to_property_opt; args } =
Option.is_some pointer_to_property_opt &&
IList.length args = 1
Int.equal (IList.length args) 1
(* A method is a setter if it has a link to a property and *)
(* it has 2 argument (this includes self) *)
let ms_is_setter { pointer_to_property_opt; args } =
Option.is_some pointer_to_property_opt &&
IList.length args = 2
Int.equal (IList.length args) 2
let make_ms name args ret_type attributes loc is_instance ?is_cpp_virtual language pointer_to_parent
pointer_to_property_opt return_param_typ =

23
infer/src/clang/cMethod_trans.ml
Unescape View File

@ -23,7 +23,9 @@ exception Invalid_declaration
type method_call_type =
| MCVirtual
| MCNoVirtual
| MCStatic
| MCStatic [@@deriving compare]
let equal_method_call_type = [%compare.equal : method_call_type]
type function_method_decl_info =
| Func_decl_info of Clang_ast_t.function_decl_info * Clang_ast_t.type_ptr
@ -297,10 +299,14 @@ let get_formal_parameters tenv ms =
| [] -> []
| (mangled, {Clang_ast_t.qt_type_ptr}):: pl' ->
let should_add_pointer name ms =
let is_objc_self = name = CFrontend_config.self &&
CMethod_signature.ms_get_lang ms = CFrontend_config.ObjC in
let is_cxx_this = name = CFrontend_config.this &&
CMethod_signature.ms_get_lang ms = CFrontend_config.CPP in
let is_objc_self =
String.equal name CFrontend_config.self &&
CFrontend_config.equal_clang_lang
(CMethod_signature.ms_get_lang ms) CFrontend_config.ObjC in
let is_cxx_this =
String.equal name CFrontend_config.this &&
CFrontend_config.equal_clang_lang
(CMethod_signature.ms_get_lang ms) CFrontend_config.CPP in
(is_objc_self && CMethod_signature.ms_is_instance ms) || is_cxx_this in
let tp = if should_add_pointer (Mangled.to_string mangled) ms then
(Ast_expressions.create_pointer_type qt_type_ptr)
@ -377,14 +383,15 @@ let get_const_args_indices ~shift args =
(** Creates a procedure description. *)
let create_local_procdesc trans_unit_ctx cfg tenv ms fbody captured is_objc_inst_method =
let defined = not ((IList.length fbody) = 0) in
let defined = not (Int.equal (IList.length fbody) 0) in
let proc_name = CMethod_signature.ms_get_name ms in
let pname = Procname.to_string proc_name in
let attributes = sil_func_attributes_of_attributes (CMethod_signature.ms_get_attributes ms) in
let method_annotation =
sil_method_annotation_of_args (CMethod_signature.ms_get_args ms) in
let is_cpp_inst_method = CMethod_signature.ms_is_instance ms
&& CMethod_signature.ms_get_lang ms = CFrontend_config.CPP in
let is_cpp_inst_method =
CMethod_signature.ms_is_instance ms &&
CFrontend_config.equal_clang_lang (CMethod_signature.ms_get_lang ms) CFrontend_config.CPP in
let create_new_procdesc () =
let formals = get_formal_parameters tenv ms in
let captured_mangled = IList.map (fun (var, t) -> (Pvar.get_name var), t) captured in

4
infer/src/clang/cMethod_trans.mli
Unescape View File

@ -19,7 +19,9 @@ open! IStd
type method_call_type =
| MCVirtual
| MCNoVirtual
| MCStatic
| MCStatic [@@deriving compare]
val equal_method_call_type : method_call_type -> method_call_type -> bool
val should_add_return_param : Typ.t -> is_objc_method:bool -> bool

22
infer/src/clang/cPredicates.ml
Unescape View File

@ -61,12 +61,12 @@ let pp_predicate fmt (name, arglist) =
Format.fprintf fmt "%s(%a)" name (Pp.comma_seq Format.pp_print_string) arglist
let is_declaration_kind decl s =
Clang_ast_proj.get_decl_kind_string decl = s
String.equal (Clang_ast_proj.get_decl_kind_string decl) s
(* st |= call_method(m) *)
let call_method m st =
match st with
| Clang_ast_t.ObjCMessageExpr (_, _, _, omei) -> omei.omei_selector = m
| Clang_ast_t.ObjCMessageExpr (_, _, _, omei) -> String.equal omei.omei_selector m
| _ -> false
let property_name_contains_word word decl =
@ -92,7 +92,7 @@ let decl_ref_is_in names st =
| Clang_ast_t.DeclRefExpr (_, _, _, drti) ->
(match drti.drti_decl_ref with
| Some dr -> let ndi, _, _ = CAst_utils.get_info_from_decl_ref dr in
IList.exists (fun n -> n = ndi.ni_name) names
IList.exists (String.equal ndi.ni_name) names
| _ -> false)
| _ -> false
@ -120,7 +120,7 @@ let is_property_pointer_type decl =
| Some ObjCObjectPointerType _
| Some BlockPointerType _ -> true
| Some TypedefType (_, tti) ->
(CAst_utils.name_of_typedef_type_info tti) = CFrontend_config.id_cl
String.equal (CAst_utils.name_of_typedef_type_info tti) CFrontend_config.id_cl
| exception Not_found -> false
| _ -> false)
| _ -> false
@ -137,7 +137,7 @@ let is_ivar_atomic stmt =
(match CAst_utils.get_decl ivar_pointer with
| Some d ->
let attributes = get_ivar_attributes d in
IList.exists (CAst_utils.equal_property_attribute `Atomic) attributes
IList.exists (PVariant.(=) `Atomic) attributes
| _ -> false)
| _ -> false
@ -154,7 +154,7 @@ let is_method_property_accessor_of_ivar stmt context =
match CAst_utils.get_decl_opt_with_decl_ref property_opt with
| Some ObjCPropertyDecl (_, _, pdi) ->
(match pdi.opdi_ivar_decl with
| Some decl_ref -> decl_ref.dr_decl_pointer = ivar_pointer
| Some decl_ref -> Int.equal decl_ref.dr_decl_pointer ivar_pointer
| None -> false)
| _ -> false
else false
@ -188,7 +188,7 @@ let is_binop_with_kind str_kind stmt =
failwith ("Binary operator kind " ^ str_kind ^ " is not valid");
match stmt with
| Clang_ast_t.BinaryOperator (_, _, _, boi) ->
Clang_ast_proj.string_of_binop_kind boi.boi_kind = str_kind
String.equal (Clang_ast_proj.string_of_binop_kind boi.boi_kind) str_kind
| _ -> false
let is_unop_with_kind str_kind stmt =
@ -196,18 +196,18 @@ let is_unop_with_kind str_kind stmt =
failwith ("Unary operator kind " ^ str_kind ^ " is not valid");
match stmt with
| Clang_ast_t.UnaryOperator (_, _, _, uoi) ->
Clang_ast_proj.string_of_unop_kind uoi.uoi_kind = str_kind
String.equal (Clang_ast_proj.string_of_unop_kind uoi.uoi_kind) str_kind
| _ -> false
let is_stmt nodename stmt =
if not (Clang_ast_proj.is_valid_astnode_kind nodename) then
failwith ("Statement " ^ nodename ^ " is not a valid statement");
nodename = Clang_ast_proj.get_stmt_kind_string stmt
String.equal nodename (Clang_ast_proj.get_stmt_kind_string stmt)
let is_decl nodename decl =
if not (Clang_ast_proj.is_valid_astnode_kind nodename) then
failwith ("Declaration " ^ nodename ^ " is not a valid declaration");
nodename = Clang_ast_proj.get_decl_kind_string decl
String.equal nodename (Clang_ast_proj.get_decl_kind_string decl)
let isa classname stmt =
match Clang_ast_proj.get_expr_tuple stmt with
@ -220,5 +220,5 @@ let decl_unavailable_in_supported_ios_sdk decl =
let available_attr_ios_sdk = get_available_attr_ios_sdk decl in
match available_attr_ios_sdk, Config.iphoneos_target_sdk_version with
| Some available_attr_ios_sdk, Some iphoneos_target_sdk_version ->
Utils.compare_versions available_attr_ios_sdk iphoneos_target_sdk_version = 1
Int.equal (Utils.compare_versions available_attr_ios_sdk iphoneos_target_sdk_version) 1
| _ -> false

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

@ -53,6 +53,8 @@ type ast_node =
| Stmt of Clang_ast_t.stmt
| Decl of Clang_ast_t.decl
let equal_ast_node = Poly.(=)
module Debug = struct
let pp_transition fmt trans_opt =
let pp_aux fmt trans = match trans with
@ -175,7 +177,7 @@ module Debug = struct
let root_node = get_root tree in
let children = get_children tree in
let edge child_node =
if root_node.content.ast_node = child_node.content.ast_node then
if equal_ast_node root_node.content.ast_node child_node.content.ast_node then
Printf.sprintf "%d -> %d [style=dotted]" root_node.id child_node.id
else
Printf.sprintf "%d -> %d [style=bold]" root_node.id child_node.id in
@ -196,9 +198,9 @@ module Debug = struct
let smart_string_of_formula phi =
let num_children = IList.length children in
match phi with
| And _ when num_children = 2 -> "(...) AND (...)"
| Or _ when num_children = 2 -> "(...) OR (...)"
| Implies _ when num_children = 2 -> "(...) ==> (...)"
| And _ when Int.equal num_children 2 -> "(...) AND (...)"
| Or _ when Int.equal num_children 2 -> "(...) OR (...)"
| Implies _ when Int.equal num_children 2 -> "(...) ==> (...)"
| Not _ -> "NOT(...)"
| _ -> Format.asprintf "%a" pp_formula phi in
Format.sprintf "(%d)\\n%s\\n%s\\n%s"

23
infer/src/clang/cTrans.ml
Unescape View File

@ -8,6 +8,7 @@
*)
open! IStd
open! PVariant
(** Translates instructions: (statements and expressions) from the ast into sil *)
@ -447,7 +448,7 @@ struct
Some BuiltinDecl.__objc_release_cf
| _ when CTrans_models.is_retain_builtin name type_ptr ->
Some BuiltinDecl.__objc_retain_cf
| _ when name = CFrontend_config.malloc &&
| _ when String.equal name CFrontend_config.malloc &&
CGeneral_utils.is_objc_extension trans_unit_ctx ->
Some BuiltinDecl.malloc_no_fail
| _ -> None
@ -874,7 +875,7 @@ struct
~f:CTrans_models.is_cf_retain_release ~default:false callee_pname_opt in
let act_params =
let params = IList.tl (collect_exprs result_trans_subexprs) in
if IList.length params = IList.length params_stmt then
if Int.equal (IList.length params) (IList.length params_stmt) then
params
else (Logging.err_debug
"WARNING: stmt_list and res_trans_par.exps must have same size. \
@ -913,7 +914,7 @@ struct
let procname = Procdesc.get_proc_name context.procdesc in
let sil_loc = CLocation.get_sil_location si context in
(* first for method address, second for 'this' expression *)
assert ((IList.length result_trans_callee.exps) = 2);
assert (Int.equal (IList.length result_trans_callee.exps) 2);
let (sil_method, _) = IList.hd result_trans_callee.exps in
let callee_pname =
match sil_method with
@ -1012,12 +1013,13 @@ struct
let receiver_kind = obj_c_message_expr_info.Clang_ast_t.omei_receiver_kind in
let selector = obj_c_message_expr_info.Clang_ast_t.omei_selector in
(* class method *)
if selector = CFrontend_config.class_method && CType.is_class method_type then
if String.equal selector CFrontend_config.class_method && CType.is_class method_type then
let class_name = CMethod_trans.get_class_name_method_call_from_receiver_kind context
obj_c_message_expr_info act_params in
raise (Self.SelfClassException class_name)
(* alloc or new *)
else if (selector = CFrontend_config.alloc) || (selector = CFrontend_config.new_str) then
else if String.equal selector CFrontend_config.alloc ||
String.equal selector CFrontend_config.new_str then
match receiver_kind with
| `Class type_ptr ->
let class_opt =
@ -1075,7 +1077,8 @@ struct
obj_c_message_expr_info in
let res_trans_subexpr_list = res_trans_add_self :: res_trans_subexpr_list in
let subexpr_exprs = collect_exprs res_trans_subexpr_list in
let is_virtual = method_call_type = CMethod_trans.MCVirtual in
let is_virtual =
CMethod_trans.equal_method_call_type method_call_type CMethod_trans.MCVirtual in
Cg.add_edge context.CContext.cg procname callee_name;
let param_exps, instr_block_param =
@ -1217,7 +1220,7 @@ struct
IList.iter
(fun n' -> Procdesc.node_set_succs_exn context.procdesc n' [prune_t; prune_f] [])
res_trans_cond.leaf_nodes;
let rnodes = if (IList.length res_trans_cond.root_nodes) = 0 then
let rnodes = if Int.equal (IList.length res_trans_cond.root_nodes) 0 then
[prune_t; prune_f]
else res_trans_cond.root_nodes in
{ empty_res_trans with
@ -1251,7 +1254,7 @@ struct
(fun n -> Procdesc.node_set_succs_exn context.procdesc n res_trans_s2.root_nodes [])
prune_to_s2;
let root_nodes_to_parent =
if (IList.length res_trans_s1.root_nodes) = 0
if Int.equal (IList.length res_trans_s1.root_nodes) 0
then res_trans_s1.leaf_nodes
else res_trans_s1.root_nodes in
let (exp1, typ1) = extract_exp res_trans_s1.exps in
@ -1630,7 +1633,7 @@ struct
let res_trans_subexpr_list =
initListExpr_initializers_trans trans_state var_exp 0 stmts typ false stmt_info in
let rh_exps = collect_exprs res_trans_subexpr_list in
if IList.length rh_exps = 0 then
if Int.equal (IList.length rh_exps) 0 then
let exps =
match Sil.zero_value_of_numerical_type_option var_type with
| Some zero_exp -> [(zero_exp, typ)]
@ -1644,7 +1647,7 @@ struct
let i = IList.length lh - IList.length rh_exps in
IList.drop_last i lh
else lh in
if IList.length rh_exps = IList.length lh then
if Int.equal (IList.length rh_exps) (IList.length lh) then
(* Creating new instructions by assigning right hand side to left hand side expressions *)
let assign_instr (lh_exp, lh_t) (rh_exp, _) = Sil.Store (lh_exp, lh_t, rh_exp, sil_loc) in
let assign_instrs =

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

@ -12,10 +12,10 @@ open! IStd
open Objc_models
let is_cf_non_null_alloc pname =
Procname.to_string pname = CFrontend_config.cf_non_null_alloc
String.equal (Procname.to_string pname) CFrontend_config.cf_non_null_alloc
let is_alloc pname =
Procname.to_string pname = CFrontend_config.cf_alloc
String.equal (Procname.to_string pname) CFrontend_config.cf_alloc
let is_alloc_model typ pname =
if Specs.summary_exists pname then false
@ -27,13 +27,13 @@ let is_alloc_model typ pname =
Core_foundation_model.is_core_lib_create typ funct
let is_builtin_expect pname =
Procname.to_string pname = CFrontend_config.builtin_expect
String.equal (Procname.to_string pname) CFrontend_config.builtin_expect
let is_builtin_object_size pname =
(Procname.to_string pname) = CFrontend_config.builtin_object_size
String.equal (Procname.to_string pname) CFrontend_config.builtin_object_size
let is_replace_with_deref_first_arg pname =
(Procname.to_string pname) = CFrontend_config.replace_with_deref_first_arg_attr
String.equal (Procname.to_string pname) CFrontend_config.replace_with_deref_first_arg_attr
let is_retain_predefined_model typ pname =
let funct = Procname.to_string pname in
@ -45,13 +45,13 @@ let is_release_predefined_model typ pname =
Core_foundation_model.is_core_graphics_release typ funct
let is_retain_method funct =
funct = CFrontend_config.retain
String.equal funct CFrontend_config.retain
let is_release_method funct =
funct = CFrontend_config.release
String.equal funct CFrontend_config.release
let is_autorelease_method funct =
funct = CFrontend_config.autorelease
String.equal funct CFrontend_config.autorelease
let get_builtinname method_name =
if is_retain_method method_name then
@ -63,7 +63,7 @@ let get_builtinname method_name =
else None
let is_modeled_builtin funct =
funct = CFrontend_config.builtin_memset_chk
String.equal funct CFrontend_config.builtin_memset_chk
let is_modeled_attribute attr_name =
IList.mem String.equal attr_name CFrontend_config.modeled_function_attributes
@ -89,17 +89,17 @@ let is_retain_builtin funct fun_type =
| _ -> false
let is_assert_log_s funct =
funct = CFrontend_config.assert_rtn ||
funct = CFrontend_config.assert_fail ||
funct = CFrontend_config.fbAssertWithSignalAndLogFunctionHelper ||
String.equal funct CFrontend_config.assert_rtn ||
String.equal funct CFrontend_config.assert_fail ||
String.equal funct CFrontend_config.fbAssertWithSignalAndLogFunctionHelper ||
String.is_substring ~substring:CFrontend_config.google_MakeCheckOpString funct
let is_assert_log_method m =
m = CFrontend_config.google_LogMessageFatal
String.equal m CFrontend_config.google_LogMessageFatal
let is_handleFailureInMethod funct =
funct = CFrontend_config.handleFailureInMethod ||
funct = CFrontend_config.handleFailureInFunction
String.equal funct CFrontend_config.handleFailureInMethod ||
String.equal funct CFrontend_config.handleFailureInFunction
let is_retain_or_release funct =
is_retain_method funct ||
@ -108,10 +108,10 @@ let is_retain_or_release funct =
let is_toll_free_bridging pn =
let funct = (Procname.to_string pn) in
funct = CFrontend_config.cf_bridging_release ||
funct = CFrontend_config.cf_bridging_retain ||
funct = CFrontend_config.cf_autorelease ||
funct = CFrontend_config.ns_make_collectable
String.equal funct CFrontend_config.cf_bridging_release ||
String.equal funct CFrontend_config.cf_bridging_retain ||
String.equal funct CFrontend_config.cf_autorelease ||
String.equal funct CFrontend_config.ns_make_collectable
let is_cf_retain_release pn =
Procname.equal pn BuiltinDecl.__objc_retain_cf
@ -143,8 +143,8 @@ let get_predefined_ms_method condition class_name method_name method_kind mk_pro
let get_predefined_ms_stringWithUTF8String class_name method_name mk_procname lang =
let condition =
class_name = CFrontend_config.nsstring_cl
&& method_name = CFrontend_config.string_with_utf8_m in
String.equal class_name CFrontend_config.nsstring_cl &&
String.equal method_name CFrontend_config.string_with_utf8_m in
let id_type = Ast_expressions.create_id_type in
let args = [(Mangled.from_string "x",
Ast_expressions.create_char_star_qual_type ~is_const:true)] in
@ -164,8 +164,8 @@ let get_predefined_ms_retain_release method_name mk_procname lang =
let get_predefined_ms_autoreleasepool_init class_name method_name mk_procname lang =
let condition =
method_name = CFrontend_config.init
&& class_name = CFrontend_config.nsautorelease_pool_cl in
String.equal method_name CFrontend_config.init &&
String.equal class_name CFrontend_config.nsautorelease_pool_cl in
let class_type = Ast_expressions.create_class_qual_type (class_name, `OBJC) in
get_predefined_ms_method condition class_name method_name Procname.ObjCInstanceMethod
mk_procname lang [(Mangled.from_string CFrontend_config.self, class_type)]
@ -173,8 +173,10 @@ let get_predefined_ms_autoreleasepool_init class_name method_name mk_procname la
let get_predefined_ms_nsautoreleasepool_release class_name method_name mk_procname lang =
let condition =
(method_name = CFrontend_config.release || method_name = CFrontend_config.drain)
&& class_name = CFrontend_config.nsautorelease_pool_cl in
(String.equal method_name CFrontend_config.release ||
String.equal method_name CFrontend_config.drain)
&&
String.equal class_name CFrontend_config.nsautorelease_pool_cl in
let class_type = Ast_expressions.create_class_qual_type (class_name, `OBJC) in
let args = [(Mangled.from_string CFrontend_config.self, class_type)] in
get_predefined_ms_method condition class_name method_name Procname.ObjCInstanceMethod
@ -182,7 +184,7 @@ let get_predefined_ms_nsautoreleasepool_release class_name method_name mk_procna
[] (Some BuiltinDecl.__objc_release_autorelease_pool)
let get_predefined_ms_is_kind_of_class class_name method_name mk_procname lang =
let condition = method_name = CFrontend_config.is_kind_of_class in
let condition = String.equal method_name CFrontend_config.is_kind_of_class in
let class_type = Ast_expressions.create_class_qual_type (class_name, `OBJC) in
let args = [(Mangled.from_string CFrontend_config.self, class_type)] in
get_predefined_ms_method condition class_name method_name Procname.ObjCInstanceMethod
@ -214,7 +216,8 @@ let is_dispatch_function_name function_name =
let rec is_dispatch functions =
match functions with
| [] -> None
| (el, block_arg_pos):: rest -> if (el = function_name) then
Some (el, block_arg_pos)
| (el, block_arg_pos):: rest ->
if (String.equal el function_name)
then Some (el, block_arg_pos)
else is_dispatch rest in
is_dispatch dispatch_functions

12
infer/src/clang/cTrans_utils.ml
Unescape View File

@ -231,7 +231,7 @@ struct
let own_priority_node pri stmt_info =
match pri with
| Busy p when p = stmt_info.Clang_ast_t.si_pointer -> true
| Busy p when Int.equal p stmt_info.Clang_ast_t.si_pointer -> true
| _ -> false
(* Used by translation functions to handle potenatial cfg nodes. *)
@ -356,9 +356,9 @@ let new_or_alloc_trans trans_state loc stmt_info type_ptr class_name_opt selecto
match class_name_opt with
| Some class_name -> class_name
| None -> CType.classname_of_type function_type in
if selector = CFrontend_config.alloc then
if String.equal selector CFrontend_config.alloc then
alloc_trans trans_state loc stmt_info function_type true None
else if selector = CFrontend_config.new_str then
else if String.equal selector CFrontend_config.new_str then
objc_new_trans trans_state loc stmt_info class_name function_type
else assert false
@ -596,7 +596,7 @@ struct
else empty_res_trans
let is_var_self pvar is_objc_method =
let is_self = Mangled.to_string (Pvar.get_name pvar) = CFrontend_config.self in
let is_self = String.equal (Mangled.to_string (Pvar.get_name pvar)) CFrontend_config.self in
is_self && is_objc_method
end
@ -612,7 +612,7 @@ let is_owning_name n =
else (
let prefix = Str.string_before s' (String.length fam) in
let suffix = Str.string_after s' (String.length fam) in
prefix = fam && not (Str.string_match (Str.regexp "[a-z]") suffix 0)
String.equal prefix fam && not (Str.string_match (Str.regexp "[a-z]") suffix 0)
) in
match Str.split (Str.regexp_string ":") n with
| fst:: _ ->
@ -706,7 +706,7 @@ let is_dispatch_function stmt_list =
| _ -> None
let is_block_enumerate_function mei =
mei.Clang_ast_t.omei_selector = CFrontend_config.enumerateObjectsUsingBlock
String.equal mei.Clang_ast_t.omei_selector CFrontend_config.enumerateObjectsUsingBlock
(* This takes a variable of type struct or array and returns a list of expressions *)
(* for each of its fields (also recursively, such that each field access is of a basic type) *)

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

@ -8,6 +8,7 @@
*)
open! IStd
open! PVariant
(** Process variable declarations by saving them as local or global variables. *)
(** Computes the local variables of a function or method to be added to the procdesc *)
@ -95,7 +96,8 @@ let captured_vars_from_block_info context cvl =
(match dr.Clang_ast_t.dr_name, dr.Clang_ast_t.dr_type_ptr with
| Some name_info, Some type_ptr ->
let n = name_info.Clang_ast_t.ni_name in
if n = CFrontend_config.self && not (CContext.is_objc_instance context) then
if String.equal n CFrontend_config.self &&
not (CContext.is_objc_instance context) then
vars
else
let pvar = sil_var_of_decl_ref context dr procname in

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

@ -189,6 +189,8 @@ struct
let module Initializers = struct
type init = Procname.t * Procdesc.t
let equal_class_opt = [%compare.equal : string option]
let final_typestates initializers_current_class =
(* Get the private methods, from the same class, directly called by the initializers. *)
let get_private_called (initializers : init list) : init list =
@ -196,14 +198,14 @@ struct
let do_proc (init_pn, init_pd) =
let filter callee_pn callee_attributes =
let is_private =
callee_attributes.ProcAttributes.access = PredSymb.Private in
PredSymb.equal_access callee_attributes.ProcAttributes.access PredSymb.Private in
let same_class =
let get_class_opt pn = match pn with
| Procname.Java pn_java ->
Some (Procname.java_get_class_name pn_java)
| _ ->
None in
get_class_opt init_pn = get_class_opt callee_pn in
equal_class_opt (get_class_opt init_pn) (get_class_opt callee_pn) in
is_private && same_class in
let private_called = PatternMatch.proc_calls
Specs.proc_resolve_attributes init_pd filter in
@ -280,7 +282,7 @@ struct
pname_and_pdescs_with
(function (pname, proc_attributes) ->
is_initializer proc_attributes &&
get_class pname = get_class curr_pname) in
equal_class_opt (get_class pname) (get_class curr_pname)) in
final_typestates
((curr_pname, curr_pdesc) :: initializers_current_class)
end
@ -292,7 +294,7 @@ struct
pname_and_pdescs_with
(fun (pname, _) ->
Procname.is_constructor pname &&
get_class pname = get_class curr_pname) in
equal_class_opt (get_class pname) (get_class curr_pname)) in
final_typestates constructors_current_class
end

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

@ -56,14 +56,14 @@ let classify_procedure proc_attributes =
let is_virtual = function
| (p, _, _):: _ when Mangled.to_string p = "this" -> true
| (p, _, _):: _ when String.equal (Mangled.to_string p) "this" -> true
| _ -> false
(** Check an access (read or write) to a field. *)
let check_field_access tenv
find_canonical_duplicate curr_pname node instr_ref exp fname ta loc : unit =
if TypeAnnotation.get_value Annotations.Nullable ta = true then
if TypeAnnotation.get_value Annotations.Nullable ta then
let origin_descr = TypeAnnotation.descr_origin tenv ta in
report_error tenv
find_canonical_duplicate
@ -82,7 +82,7 @@ let check_array_access tenv
ta
loc
indexed =
if TypeAnnotation.get_value Annotations.Nullable ta = true then
if TypeAnnotation.get_value Annotations.Nullable ta then
let origin_descr = TypeAnnotation.descr_origin tenv ta in
report_error tenv
find_canonical_duplicate
@ -99,6 +99,9 @@ type from_call =
| From_is_true_on_null (** returns true on null *)
| From_optional_isPresent (** x.isPresent *)
| From_containsKey (** x.containsKey *)
[@@ deriving compare]
let equal_from_call = [%compare.equal : from_call]
(** Check the normalized "is zero" or "is not zero" condition of a prune instruction. *)
let check_condition tenv case_zero find_canonical_duplicate curr_pdesc
@ -141,13 +144,13 @@ let check_condition tenv case_zero find_canonical_duplicate curr_pdesc
let is_temp = Idenv.exp_is_temp idenv e in
let nonnull = is_fun_nonnull ta in
let should_report =
TypeAnnotation.get_value Annotations.Nullable ta = false &&
not (TypeAnnotation.get_value Annotations.Nullable ta) &&
(Config.eradicate_condition_redundant || nonnull) &&
true_branch &&
(not is_temp || nonnull) &&
PatternMatch.type_is_class typ &&
not (from_try_with_resources ()) &&
from_call = From_condition &&
equal_from_call from_call From_condition &&
not (TypeAnnotation.origin_is_fun_library ta) in
let is_always_true = not case_zero in
let nonnull = is_fun_nonnull ta in
@ -181,15 +184,15 @@ let check_field_assignment tenv
Annotations.ia_is_field_injector_readwrite ia
| _ ->
false in
TypeAnnotation.get_value Annotations.Nullable ta_lhs = false &&
TypeAnnotation.get_value Annotations.Nullable ta_rhs = true &&
not (TypeAnnotation.get_value Annotations.Nullable ta_lhs) &&
TypeAnnotation.get_value Annotations.Nullable ta_rhs &&
PatternMatch.type_is_class t_lhs &&
not (Ident.java_fieldname_is_outer_instance fname) &&
not (field_is_field_injector_readwrite ()) in
let should_report_absent =
Config.eradicate_optional_present &&
TypeAnnotation.get_value Annotations.Present ta_lhs = true &&
TypeAnnotation.get_value Annotations.Present ta_rhs = false &&
TypeAnnotation.get_value Annotations.Present ta_lhs &&
not (TypeAnnotation.get_value Annotations.Present ta_rhs) &&
not (Ident.java_fieldname_is_outer_instance fname) in
let should_report_mutable =
let field_is_mutable () = match t_ia_opt with
@ -278,7 +281,7 @@ let check_constructor_initialization tenv
final_type_annotation_with
true
(Lazy.force final_constructor_typestates)
(fun ta -> TypeAnnotation.get_value Annotations.Nullable ta = true) in
(fun ta -> TypeAnnotation.get_value Annotations.Nullable ta) in
let should_check_field_initialization =
let in_current_class =
@ -442,7 +445,7 @@ let check_call_parameters tenv
let tot_param_num = IList.length sig_params - (if has_this then 1 else 0) in
let rec check sparams cparams = match sparams, cparams with
| (s1, ia1, t1) :: sparams', ((orig_e2, e2), t2) :: cparams' ->
let param_is_this = Mangled.to_string s1 = "this" in
let param_is_this = String.equal (Mangled.to_string s1) "this" in
let formal_is_nullable = Annotations.ia_is_nullable ia1 in
let formal_is_present = Annotations.ia_is_present ia1 in
let (_, ta2, _) =
@ -539,7 +542,7 @@ let check_overridden_annotations
let current_params = annotated_signature.Annotations.params
and overridden_params = overriden_signature.Annotations.params in
let initial_pos = if is_virtual current_params then 0 else 1 in
if (IList.length current_params) = (IList.length overridden_params) then
if Int.equal (IList.length current_params) (IList.length overridden_params) then
ignore (IList.fold_left2 compare initial_pos current_params overridden_params) in
let check overriden_proc_name =

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

@ -385,7 +385,9 @@ let typecheck_instr
let constructor_check_calls_this calls_this pn =
match curr_pname, pn with
| Procname.Java curr_pname_java, Procname.Java pn_java ->
if Procname.java_get_class_name curr_pname_java = Procname.java_get_class_name pn_java
if String.equal
(Procname.java_get_class_name curr_pname_java)
(Procname.java_get_class_name pn_java)
then calls_this := true
| _ ->
() in
@ -402,7 +404,7 @@ let typecheck_instr
(* Drop reference parameters to this and outer objects. *)
let is_hidden_parameter (n, _) =
let n_str = Mangled.to_string n in
n_str = "this" ||
String.equal n_str "this" ||
Str.string_match (Str.regexp "$bcvar[0-9]+") n_str 0 in
let rec drop_n_args ntl = match ntl with
| fp:: tail when is_hidden_parameter fp -> 1 + drop_n_args tail
@ -573,7 +575,7 @@ let typecheck_instr
IList.mapi
(fun i (_, typ) ->
let arg =
if i = 0 &&
if Int.equal i 0 &&
not (Procname.java_is_static callee_pname)
then "this"
else Printf.sprintf "arg%d" i in
@ -634,7 +636,7 @@ let typecheck_instr
| Some (t, ta, _) ->
let should_report =
Config.eradicate_condition_redundant &&
TypeAnnotation.get_value Annotations.Nullable ta = false &&
not (TypeAnnotation.get_value Annotations.Nullable ta) &&
not (TypeAnnotation.origin_is_fun_library ta) in
if checks.eradicate && should_report then
begin
@ -824,7 +826,7 @@ let typecheck_instr
else typestate1 in
let has_method pn name = match pn with
| Procname.Java pn_java ->
Procname.java_get_method pn_java = name
String.equal (Procname.java_get_method pn_java) name
| _ ->
false in
if Models.is_check_not_null callee_pname then
@ -997,7 +999,7 @@ let typecheck_instr
begin
match from_call with
| EradicateChecks.From_optional_isPresent ->
if TypeAnnotation.get_value Annotations.Present ta = false
if not (TypeAnnotation.get_value Annotations.Present ta)
then set_flag e' Annotations.Present true typestate2
else typestate2
| EradicateChecks.From_is_true_on_null ->
@ -1084,7 +1086,7 @@ let typecheck_node
typestates_exn := typestate :: !typestates_exn
| Sil.Store (Exp.Lvar pv, _, _, _) when
Pvar.is_return pv &&
Procdesc.Node.get_kind node = Procdesc.Node.throw_kind ->
Procdesc.Node.equal_nodekind (Procdesc.Node.get_kind node) Procdesc.Node.throw_kind ->
(* throw instruction *)
typestates_exn := typestate :: !typestates_exn
| _ -> () in
@ -1107,7 +1109,9 @@ let typecheck_node
let typestate_succ = IList.fold_left (do_instruction ext) typestate instrs in
let dont_propagate =
Procdesc.Node.get_kind node = Procdesc.Node.exn_sink_kind (* don't propagate exceptions *)
Procdesc.Node.equal_nodekind
(Procdesc.Node.get_kind node)
Procdesc.Node.exn_sink_kind (* don't propagate exceptions *)
||
!noreturn in
if dont_propagate

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

@ -91,7 +91,7 @@ let get_lifecycle_for_framework_typ_opt tenv lifecycle_typ lifecycle_proc_strs =
IList.find (fun decl_proc ->
match decl_proc with
| Procname.Java decl_proc_java ->
lifecycle_proc = Procname.java_get_method decl_proc_java
String.equal lifecycle_proc (Procname.java_get_method decl_proc_java)
| _ ->
false
) methods in

4
infer/src/harness/inhabit.ml
Unescape View File

@ -61,7 +61,7 @@ let create_fresh_local_name () =
"dummy_local" ^ string_of_int !local_name_cntr
(** more forgiving variation of IList.tl that won't raise an exception on the empty list *)
let tl_or_empty l = if l = [] then l else IList.tl l
let tl_or_empty l = if List.is_empty l then l else IList.tl l
let get_non_receiver_formals formals = tl_or_empty formals
@ -173,7 +173,7 @@ and inhabit_constructor tenv constr_name (allocated_obj, obj_type) cfg env =
let inhabit_call_with_args procname procdesc args env =
let retval =
let ret_typ = Procdesc.get_ret_type procdesc in
let is_void = ret_typ = Typ.Tvoid in
let is_void = Typ.equal ret_typ Typ.Tvoid in
if is_void then None else Some (Ident.create_fresh Ident.knormal, ret_typ) in
let call_instr =
let fun_exp = fun_exp_from_name procname in

4
infer/src/integration/Maven.ml
Unescape View File

@ -56,7 +56,7 @@ let add_infer_profile_to_xml maven_xml infer_xml =
| `El_start tag ->
Xmlm.output xml_out elt_in;
let tag_name = snd (fst tag) in
if tag_name = "profiles" then (
if String.equal tag_name "profiles" then (
found_profiles_tag := true
);
process xml_in xml_out (tag_name::tag_stack)
@ -86,7 +86,7 @@ let add_infer_profile_to_xml maven_xml infer_xml =
| `Data data ->
Xmlm.output xml_out elt_in;
(match tag_stack with
| "id"::"profile"::"profiles"::_ when data = infer_profile_name ->
| "id"::"profile"::"profiles"::_ when String.equal data infer_profile_name ->
L.do_out "Found infer profile, not adding one@.";
found_infer_profile := true
| "module"::"modules"::_ ->

17
infer/src/java/jFrontend.ml
Unescape View File

@ -9,6 +9,7 @@
*)
open! IStd
open! PVariant
open Javalib_pack
open Sawja_pack
@ -20,7 +21,7 @@ let add_edges
(context : JContext.t) start_node exn_node exit_nodes method_body_nodes impl super_call =
let pc_nb = Array.length method_body_nodes in
let last_pc = pc_nb - 1 in
let is_last pc = (pc = last_pc) in
let is_last pc = Int.equal pc last_pc in
let rec get_body_nodes pc =
let current_nodes = method_body_nodes.(pc) in
match current_nodes with
@ -37,7 +38,7 @@ let add_edges
match JContext.get_goto_jump context pc with
| JContext.Next -> get_body_nodes (pc + 1)
| JContext.Jump goto_pc ->
if pc = goto_pc then [] (* loop in goto *)
if Int.equal pc goto_pc then [] (* loop in goto *)
else get_body_nodes goto_pc
| JContext.Exit -> exit_nodes in
let get_succ_nodes node pc =
@ -105,8 +106,8 @@ let cache_classname cn =
let splitted_root_dir =
let rec split l p =
match p with
| p when p = Filename.current_dir_name -> l
| p when p = Filename.dir_sep -> l
| p when String.equal p Filename.current_dir_name -> l
| p when String.equal p Filename.dir_sep -> l
| p -> split ((Filename.basename p):: l) (Filename.dirname p) in
split [] (Filename.dirname path) in
let rec mkdir l p =
@ -163,8 +164,8 @@ let should_capture classes package_opt source_basename node =
let classname = Javalib.get_name node in
let match_package pkg cn =
match JTransType.package_to_string (JBasics.cn_package cn) with
| None -> pkg = ""
| Some found_pkg -> found_pkg = pkg in
| None -> String.equal pkg ""
| Some found_pkg -> String.equal found_pkg pkg in
if JBasics.ClassSet.mem classname classes then
begin
match Javalib.get_sourcefile node with
@ -172,10 +173,10 @@ let should_capture classes package_opt source_basename node =
| Some found_basename ->
begin
match package_opt with
| None -> found_basename = source_basename
| None -> String.equal found_basename source_basename
| Some pkg ->
match_package pkg classname
&& found_basename = source_basename
&& String.equal found_basename source_basename
end
end
else false

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

@ -81,7 +81,7 @@ let get_undefined_method_call ovt =
match ot with
| JBasics.TArray _ -> assert false
| JBasics.TClass cn ->
if JBasics.cn_name cn = JConfig.string_cl then
if String.equal (JBasics.cn_name cn) JConfig.string_cl then
"string_undefined"
else
if JBasics.cn_equal cn JBasics.java_lang_object then
@ -97,7 +97,7 @@ let get_undefined_method_call ovt =
let retrieve_fieldname fieldname =
try
let subs = Str.split (Str.regexp (Str.quote ".")) (Ident.fieldname_to_string fieldname) in
if IList.length subs = 0 then
if Int.equal (IList.length subs) 0 then
assert false
else
IList.hd (IList.rev subs)
@ -108,7 +108,7 @@ let get_field_name program static tenv cn fs =
let { StructTyp.fields; statics; } = JTransType.get_class_struct_typ program tenv cn in
match
IList.find
(fun (fieldname, _, _) -> retrieve_fieldname fieldname = JBasics.fs_name fs)
(fun (fieldname, _, _) -> String.equal (retrieve_fieldname fieldname) (JBasics.fs_name fs))
(if static then statics else fields)
with
| fieldname, _, _ ->
@ -226,10 +226,10 @@ let get_test_operator op =
| `Ne -> Binop.Ne
let is_java_native cm =
(cm.Javalib.cm_implementation = Javalib.Native)
Poly.(=) cm.Javalib.cm_implementation Javalib.Native
let is_clone ms =
JBasics.ms_name ms = JConfig.clone_name
String.equal (JBasics.ms_name ms) JConfig.clone_name
let get_implementation cm =
match cm.Javalib.cm_implementation with
@ -258,7 +258,7 @@ let get_implementation cm =
(hacked_bytecode, jbir_code)
let update_constr_loc cn ms loc_start =
if (JBasics.ms_name ms) = JConfig.constructor_name then
if String.equal (JBasics.ms_name ms) JConfig.constructor_name then
try ignore(JBasics.ClassMap.find cn !constr_loc_map)
with Not_found -> constr_loc_map := (JBasics.ClassMap.add cn loc_start !constr_loc_map)
@ -411,7 +411,7 @@ let rec expression (context : JContext.t) pc expr =
| JBir.Const c ->
begin
match c with (* We use the constant <field> internally to mean a variable. *)
| `String s when (JBasics.jstr_pp s) = JConfig.field_cst ->
| `String s when String.equal (JBasics.jstr_pp s) JConfig.field_cst ->
let varname = JConfig.field_st in
let procname = (Procdesc.get_proc_name context.procdesc) in
let pvar = Pvar.mk varname procname in
@ -639,9 +639,9 @@ let detect_loop entry_pc impl =
begin
let visited_updated = Int.Set.add visited pc in
match code.(pc) with
| JBir.Goto goto_pc when goto_pc = entry_pc -> (true, empty)
| JBir.Goto goto_pc when Int.equal goto_pc entry_pc -> (true, empty)
| JBir.Goto goto_pc -> loop visited_updated goto_pc
| JBir.Ifd (_, if_pc) when if_pc = entry_pc -> (true, empty)
| JBir.Ifd (_, if_pc) when Int.equal if_pc entry_pc -> (true, empty)
| JBir.Ifd (_, if_pc) ->
let (loop_detected, visited_after) = loop visited_updated (pc + 1) in
if loop_detected then
@ -649,7 +649,7 @@ let detect_loop entry_pc impl =
else
loop visited_after if_pc
| _ ->
if (pc + 1) = entry_pc then
if Int.equal (pc + 1) entry_pc then
(true, empty)
else
loop visited_updated (pc + 1)
@ -680,7 +680,7 @@ let is_this expr =
begin
match JBir.var_name_debug var with
| None -> false
| Some name_opt -> Mangled.to_string JConfig.this = name_opt
| Some name_opt -> String.equal (Mangled.to_string JConfig.this) name_opt
end
| _ -> false

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

@ -94,7 +94,7 @@ let translate_exceptions (context : JContext.t) exit_nodes get_body_nodes handle
create_node loc node_kind_false instrs_false in
Procdesc.node_set_succs_exn procdesc node_true catch_nodes exit_nodes;
Procdesc.node_set_succs_exn procdesc node_false succ_nodes exit_nodes;
let is_finally = handler.JBir.e_catch_type = None in
let is_finally = is_none handler.JBir.e_catch_type in
if is_finally
then [node_true] (* TODO (#4759480): clean up the translation so prune nodes are not created at all *)
else [node_true; node_false] in

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

@ -173,7 +173,7 @@ let method_signature_names ms =
let return_type_name =
match JBasics.ms_rtype ms with
| None ->
if JBasics.ms_name ms = JConfig.constructor_name then
if String.equal (JBasics.ms_name ms) JConfig.constructor_name then
None
else
Some (None, JConfig.void)
@ -384,7 +384,7 @@ let sizeof_of_object_type program tenv ot subtypes =
(** return the name and type of a formal parameter, looking up the class name in case of "this" *)
let param_type program tenv cn name vt =
if (JBir.var_name_g name) = Mangled.to_string JConfig.this
if String.equal (JBir.var_name_g name) (Mangled.to_string JConfig.this)
then get_class_type program tenv cn
else value_type program tenv vt

6
infer/src/unit/TraceTests.ml
Unescape View File

@ -58,7 +58,7 @@ module MockSource = struct
let get_tainted_formals _ = assert false
end))
let equal source1 source2 = compare source1 source2 = 0
let equal = [%compare.equal : t]
end
module MockSink = struct
@ -67,7 +67,7 @@ module MockSink = struct
let get _ = assert false
let equal sink1 sink2 = compare sink1 sink2 = 0
let equal = [%compare.equal : t]
end
@ -76,7 +76,7 @@ module MockTrace = Trace.Make(struct
module Sink = MockSink
let should_report source sink =
Source.kind source = Sink.kind sink
[%compare.equal : MockTraceElem.t] (Source.kind source) (Sink.kind sink)
end)
let tests =

2
infer/src/unit/accessPathTests.ml
Unescape View File

@ -140,7 +140,7 @@ let tests =
F.fprintf fmt "Expected %s but got %s" expected actual in
let assert_eq input_aps expected =
let input = F.asprintf "%a" AccessPathDomains.Set.pp input_aps in
assert_equal ~cmp:(=) ~pp_diff input expected in
assert_equal ~cmp:String.equal ~pp_diff input expected in
let aps1 = AccessPathDomains.Set.of_list [x_exact; x_abstract] in (* { x*, x } *)
let aps2 = AccessPathDomains.Set.add xF_exact aps1 in (* x*, x, x.f *)
let aps3 = AccessPathDomains.Set.add yF_exact aps2 in (* x*, x, x.f, y.f *)

2
infer/src/unit/accessTreeTests.ml
Unescape View File

@ -445,7 +445,7 @@ let tests =
(fun (ap, trace) -> AccessPath.equal ap ap_in && MockTraceDomain.equal trace trace_in)
ap_traces in
assert_bool "Should have six ap/trace pairs" (IList.length ap_traces = 6);
assert_bool "Should have six ap/trace pairs" (Int.equal (IList.length ap_traces) 6);
assert_bool "has x pair" (has_ap_trace_pair x x_trace);
assert_bool "has xF pair" (has_ap_trace_pair xF xF_trace);
assert_bool "has xFG pair" (has_ap_trace_pair xFG xFG_trace);

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

@ -96,7 +96,9 @@ let tests =
end;
assert_bool
"underlying_node should return node of underlying CFG type"
(Procdesc.Node.get_id (BackwardInstrCfg.underlying_node n1) = BackwardCfg.id n1) in
(Procdesc.Node.equal_id
(Procdesc.Node.get_id (BackwardInstrCfg.underlying_node n1))
(BackwardCfg.id n1)) in
"instr_test">::instr_test_ in
let graph_tests = [

6
infer/src/unit/schedulerTests.ml
Unescape View File

@ -35,13 +35,13 @@ module MockProcCfg = struct
include (MockNode : module type of MockNode with type t := node)
type t = (node * node list) list
let compare_id = Int.compare
let equal_id = Int.equal
let succs t n =
try
let node_id = id n in
IList.find
(fun (node, _) -> compare_id (id node) node_id = 0)
(fun (node, _) -> equal_id (id node) node_id)
t
|> snd
with Not_found -> []
@ -51,7 +51,7 @@ module MockProcCfg = struct
let node_id = id n in
IList.filter
(fun (_, succs) ->
IList.exists (fun node -> compare_id (id node) node_id = 0) succs)
IList.exists (fun node -> equal_id (id node) node_id) succs)
t
|> IList.map fst
with Not_found -> []

Write Preview
Loading…
Cancel
Save