extract callsite to its own module

Reviewed By: jberdine

Differential Revision: D3636918

fbshipit-source-id: eaaac66

infer/src/backend/CallSite.ml

@@ -0,0 +1,46 @@
+(*
+ * Copyright (c) 2016 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ *)
+
+module F = Format
+
+type t =
+  {
+    pname : Procname.t;
+    loc : Location.t;
+  }
+
+let compare t1 t2 =
+  let n = Procname.compare t1.pname t2.pname in
+  if n <> 0
+  then n
+  else Location.compare t1.loc t2.loc
+
+let equal t1 t2 =
+  compare t1 t2 = 0
+
+let pname t =
+  t.pname
+
+let loc t =
+  t.loc
+
+let make pname loc =
+  { pname; loc; }
+
+let dummy =
+  make Procname.empty_block Location.dummy
+
+let pp fmt t =
+  F.fprintf fmt "%a at %a" Procname.pp t.pname Location.pp t.loc
+
+module Set = PrettyPrintable.MakePPSet(struct
+    type nonrec t = t
+    let compare = compare
+    let pp_element = pp
+  end)

infer/src/backend/CallSite.mli

@@ -0,0 +1,28 @@
+(*
+ * Copyright (c) 2016 - present Facebook, Inc.
+ * All rights reserved.
+ *
+ * This source code is licensed under the BSD style license found in the
+ * LICENSE file in the root directory of this source tree. An additional grant
+ * of patent rights can be found in the PATENTS file in the same directory.
+ *)
+
+module F = Format
+
+type t
+
+val compare : t -> t -> int
+
+val equal : t -> t -> bool
+
+val pname : t -> Procname.t
+
+val loc : t -> Location.t
+
+val make : Procname.t -> Location.t -> t
+
+val dummy : t
+
+val pp : F.formatter -> t -> unit
+
+module Set : PrettyPrintable.PPSet with type elt = t

infer/src/backend/specs.ml

@@ -307,24 +307,7 @@ type phase = FOOTPRINT | RE_EXECUTION
 
 type dependency_map_t = int Procname.Map.t
 
-(* name of callee + location of the call *)
+type call_summary = CallSite.Set.t Typ.AnnotMap.t
-type call_site = Procname.t * Location.t
-
-let compare_call_site (pname1, loc1) (pname2, loc2) =
-  let n = Procname.compare pname1 pname2 in
-  if n <> 0
-  then n
-  else Location.compare loc1 loc2
-
-let pp_call_site fmt (pname, loc) = F.fprintf fmt "%a at %a" Procname.pp pname Location.pp loc
-
-module CallSiteSet = PrettyPrintable.MakePPSet(struct
-    type t = call_site
-    let compare = compare_call_site
-    let pp_element = pp_call_site
-  end)
-
-type call_summary = CallSiteSet.t Typ.AnnotMap.t
 
 (** Payload: results of some analysis *)
 type payload =

infer/src/backend/specs.mli

@@ -117,12 +117,7 @@ type phase = FOOTPRINT | RE_EXECUTION
 
 type dependency_map_t = int Procname.Map.t
 
-(** Type for calls consiting in the name of the callee and the location of the call *)
+type call_summary = CallSite.Set.t Typ.AnnotMap.t
-type call_site = Procname.t * Location.t
-
-module CallSiteSet : PrettyPrintable.PPSet with type elt = call_site
-
-type call_summary = CallSiteSet.t Typ.AnnotMap.t
 
 (** Payload: results of some analysis *)
 type payload =

infer/src/checkers/annotationReachability.ml

@@ -12,7 +12,7 @@ open! Utils
 module F = Format
 module L = Logging
 
-module CallSiteSet = AbstractDomain.FiniteSet (Specs.CallSiteSet)
+module CallSiteSet = AbstractDomain.FiniteSet (CallSite.Set)
 module CallsDomain = AbstractDomain.Map (Typ.AnnotMap) (CallSiteSet)
 
 let dummy_constructor_annot = "__infer_is_constructor"
@@ -176,13 +176,13 @@ let method_has_annot annot tenv pname =
 let method_overrides_annot annot tenv pname =
   method_overrides (method_has_annot annot) tenv pname
 
-let lookup_annotation_calls annot pname =
+let lookup_annotation_calls annot pname : CallSite.t list =
   match Specs.get_summary pname with
   | Some { Specs.payload = { Specs.calls = Some call_map; }; } ->
       begin
         try
           Typ.AnnotMap.find annot call_map
-          |> Specs.CallSiteSet.elements
+          |> CallSiteSet.elements
         with Not_found ->
           []
       end
@@ -240,7 +240,7 @@ let report_annotation_stack src_annot snk_annot src_pname loc trace stack_str sn
       Exceptions.Checkers (msg, Localise.verbatim_desc description) in
     Reporting.log_error src_pname ~loc: (Some loc) ~ltr: (Some final_trace) exn
 
-let report_call_stack end_of_stack lookup_next_calls report pname loc calls =
+let report_call_stack end_of_stack lookup_next_calls report call_site calls =
   (* TODO: stop using this; we can use the call site instead *)
   let lookup_location pname =
     match Specs.get_summary pname with
@@ -248,7 +248,7 @@ let report_call_stack end_of_stack lookup_next_calls report pname loc calls =
     | Some summary -> summary.Specs.attributes.ProcAttributes.loc in
   let rec loop fst_call_loc visited_pnames (trace, stack_str) (callee_pname, call_loc) =
     if end_of_stack callee_pname then
-      report pname fst_call_loc trace stack_str callee_pname call_loc
+      report (CallSite.pname call_site) fst_call_loc trace stack_str callee_pname call_loc
     else
       let callee_def_loc = lookup_location callee_pname in
       let next_calls = lookup_next_calls callee_pname in
@@ -257,14 +257,18 @@ let report_call_stack end_of_stack lookup_next_calls report pname loc calls =
       let new_trace = update_trace call_loc trace |> update_trace callee_def_loc in
       let unseen_pnames, updated_visited =
         IList.fold_left
-          (fun (accu, set) (p, loc) ->
+          (fun (accu, set) call_site ->
+             let p = CallSite.pname call_site in
+             let loc = CallSite.loc call_site in
              if Procname.Set.mem p set then (accu, set)
              else ((p, loc) :: accu, Procname.Set.add p set))
           ([], visited_pnames) next_calls in
       IList.iter (loop fst_call_loc updated_visited (new_trace, new_stack_str)) unseen_pnames in
   IList.iter
-    (fun (fst_callee_pname, fst_call_loc) ->
+    (fun fst_call_site ->
-       let start_trace = update_trace loc [] in
+       let fst_callee_pname = CallSite.pname fst_call_site in
+       let fst_call_loc = CallSite.loc fst_call_site in
+       let start_trace = update_trace (CallSite.loc call_site) [] in
        loop fst_call_loc Procname.Set.empty (start_trace, "") (fst_callee_pname, fst_call_loc))
     calls
 
@@ -311,8 +315,8 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
     let add_call_for_annot annot _ astate =
       let calls =
         try Typ.AnnotMap.find annot call_map
-        with Not_found -> Specs.CallSiteSet.empty in
+        with Not_found -> CallSiteSet.empty in
-      if (not (Specs.CallSiteSet.is_empty calls) || method_has_annot annot tenv callee_pname) &&
+      if (not (CallSiteSet.is_empty calls) || method_has_annot annot tenv callee_pname) &&
          (not (method_is_sanitizer annot tenv caller_pname))
       then
         Domain.add_call annot call_site astate
@@ -331,7 +335,7 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
         Domain.add_tracking_var (Var.of_id id) astate
     | Sil.Call (_, Const (Cfun callee_pname), _, call_loc, _) ->
         let caller_pname = Cfg.Procdesc.get_proc_name pdesc in
-        let call_site = callee_pname, call_loc in
+        let call_site = CallSite.make callee_pname call_loc in
         begin
           (* Runs the analysis of callee_pname if not already analyzed *)
           match Summary.read_summary pdesc callee_pname with
@@ -399,9 +403,9 @@ module Interprocedural = struct
       let extract_calls_with_annot annot call_map =
         try
           Typ.AnnotMap.find annot call_map
-          |> Specs.CallSiteSet.elements
+          |> CallSiteSet.elements
         with Not_found -> [] in
-      let report_src_snk_path calls src_annot =
+      let report_src_snk_path (calls : CallSite.t list) src_annot =
         if method_overrides_annot src_annot tenv proc_name
         then
           let f_report =
@@ -410,8 +414,7 @@ module Interprocedural = struct
             (method_has_annot snk_annot tenv)
             (lookup_annotation_calls snk_annot)
             f_report
-            proc_name
+            (CallSite.make proc_name loc)
-            loc
             calls in
       let calls = extract_calls_with_annot snk_annot call_map in
       if not (IList.length calls = 0)