[starvation] change UI-thread trace element from string to a proper type

Summary:
Starvation analysis keeps a trace documenting why a method is seen as on the UI thread (many reasons possible, often confusing).  This was a call-stack plus string, for keeping the explanation of why the last callee is on the UI thread.  This is bad, because it takes too much memory/storage (each string is custom-made to the classes/method involved), and is effectively untyped.

Switch to a proper type for explaining this, so the cost is just a few pointers plus shared procnames/types, and then convert to string only when reporting.  This will also allow to push the UI trace inside each element of the starvation domain, so as to allow path sensitivity etc, without blowing up summary size.

Reviewed By: ezgicicek, artempyanykh

Differential Revision: D17810007

fbshipit-source-id: cdd743975

infer/src/concurrency/ConcurrencyModels.ml

@@ -6,8 +6,6 @@
  *)
 
 open! IStd
-module F = Format
-module MF = MarkupFormatter
 module L = Logging
 
 type lock_effect =
@@ -351,13 +349,14 @@ let ui_matcher_records =
     ; methods= ["on"] } ]
 
 
-let is_ui_method =
+let is_modeled_ui_method =
   let matchers = List.map ui_matcher_records ~f:MethodMatcher.of_record in
   (* we pass an empty actuals list because all matching is done on class and method name here *)
   fun tenv pname -> MethodMatcher.of_list matchers tenv pname []
 
 
 type annotation_trail = DirectlyAnnotated | Override of Typ.Procname.t | SuperClass of Typ.name
+[@@deriving compare]
 
 let find_override_or_superclass_annotated ~attrs_of_pname is_annot tenv proc_name =
   let is_annotated pn = Annotations.pname_has_return_annot pn ~attrs_of_pname is_annot in
@@ -382,40 +381,13 @@ let find_override_or_superclass_annotated ~attrs_of_pname is_annot tenv proc_nam
   else Typ.Procname.get_class_type_name proc_name |> Option.bind ~f:find_override_or_superclass_aux
 
 
-let mono_pname = MF.wrap_monospaced Typ.Procname.pp
+let annotated_as_worker_thread ~attrs_of_pname tenv pname =
+  find_override_or_superclass_annotated ~attrs_of_pname Annotations.ia_is_worker_thread tenv pname
 
-let runs_on_ui_thread ~attrs_of_pname tenv pname =
-  let is_uithread = Annotations.ia_is_uithread_equivalent in
-  let describe ~procname fmt = function
-    | DirectlyAnnotated ->
-        F.fprintf fmt "%a is annotated %a" mono_pname procname MF.pp_monospaced
-          Annotations.ui_thread
-    | Override override_pname ->
-        F.fprintf fmt "class %a overrides %a, which is annotated %a" mono_pname procname mono_pname
-          override_pname MF.pp_monospaced Annotations.ui_thread
-    | SuperClass class_name -> (
-      match Typ.Procname.get_class_type_name procname with
-      | None ->
-          L.die InternalError "Cannot get class of method %a@." Typ.Procname.pp procname
-      | Some current_class ->
-          let pp_extends fmt current_class =
-            if Typ.Name.equal current_class class_name then ()
-            else F.fprintf fmt " extends %a, which" (MF.wrap_monospaced Typ.Name.pp) class_name
-          in
-          F.fprintf fmt "class %s%a is annotated %a"
-            (MF.monospaced_to_string (Typ.Name.name current_class))
-            pp_extends current_class MF.pp_monospaced Annotations.ui_thread )
-  in
-  if
-    find_override_or_superclass_annotated ~attrs_of_pname Annotations.ia_is_worker_thread tenv
+
+let annotated_as_uithread_equivalent ~attrs_of_pname tenv pname =
+  find_override_or_superclass_annotated ~attrs_of_pname Annotations.ia_is_uithread_equivalent tenv
     pname
-    |> Option.is_some
-  then None
-  else if is_ui_method tenv pname then
-    Some (F.asprintf "%a is a standard UI-thread method" mono_pname pname)
-  else
-    find_override_or_superclass_annotated ~attrs_of_pname is_uithread tenv pname
-    |> Option.map ~f:(fun trail -> F.asprintf "%a" (describe ~procname:pname) trail)
 
 
 let cpp_lock_types_matcher = Clang.lock_types_matcher

infer/src/concurrency/ConcurrencyModels.mli

@@ -32,16 +32,8 @@ val get_lock_effect : Typ.Procname.t -> HilExp.t list -> lock_effect
 val get_thread : Typ.Procname.t -> thread
 (** describe how this procedure behaves with respect to thread access *)
 
-val runs_on_ui_thread :
-     attrs_of_pname:(BuiltinDecl.t -> ProcAttributes.t option)
-  -> Tenv.t
-  -> Typ.Procname.t
-  -> string option
-(** We don't want to warn on methods that run on the UI thread because they should always be
-    single-threaded. Assume that methods annotated with @UiThread, @OnEvent, @OnBind, @OnMount,
-    @OnUnbind, @OnUnmount always run on the UI thread.  Also assume that any superclass
-    marked @UiThread implies all methods are on UI thread. Return Some string explaining why
-    this method is on the UI thread, else return None. *)
+val is_modeled_ui_method : Tenv.t -> Typ.Procname.t -> bool
+(** is it a modeled UI thread method? *)
 
 val get_current_class_and_annotated_superclasses :
   (Annot.Item.t -> bool) -> Tenv.t -> Typ.Procname.t -> (Typ.name * Typ.name list) option
@@ -55,6 +47,7 @@ type annotation_trail =
   | DirectlyAnnotated  (** the method is directly annotated as such *)
   | Override of Typ.Procname.t  (** it overrides a method annotated in a super class *)
   | SuperClass of Typ.name  (** the method's class or a super class of that is annotated as such *)
+[@@deriving compare]
 
 val find_override_or_superclass_annotated :
      attrs_of_pname:(BuiltinDecl.t -> ProcAttributes.t option)
@@ -62,4 +55,18 @@ val find_override_or_superclass_annotated :
   -> Tenv.t
   -> Typ.Procname.t
   -> annotation_trail sexp_option
-(** check if a method's annotations satisfy the given predicate *)
+(** check if a method's transitive annotations satisfy the given predicate *)
+
+val annotated_as_worker_thread :
+     attrs_of_pname:(BuiltinDecl.t -> ProcAttributes.t option)
+  -> Tenv.t
+  -> Typ.Procname.t
+  -> annotation_trail sexp_option
+(** check if a method is transitively annotated @WorkerThread *)
+
+val annotated_as_uithread_equivalent :
+     attrs_of_pname:(BuiltinDecl.t -> ProcAttributes.t option)
+  -> Tenv.t
+  -> Typ.Procname.t
+  -> annotation_trail sexp_option
+(** check if a method is transitively annotated @UIThread or equivalent *)

infer/src/concurrency/RacerD.ml

@@ -500,7 +500,6 @@ let analyze_procedure {Callbacks.exe_env; summary} =
   let proc_name = Summary.get_proc_name summary in
   let tenv = Exe_env.get_tenv exe_env proc_name in
   let open RacerDModels in
-  let open ConcurrencyModels in
   let method_annotation = (Procdesc.get_attributes proc_desc).method_annotation in
   let is_initializer tenv proc_name =
     Typ.Procname.is_constructor proc_name || FbThreadSafety.is_custom_init tenv proc_name
@@ -513,7 +512,6 @@ let analyze_procedure {Callbacks.exe_env; summary} =
       let threads =
         if
           runs_on_ui_thread ~attrs_of_pname:Summary.OnDisk.proc_resolve_attributes tenv proc_name
-          |> Option.is_some
           || is_thread_confined_method tenv proc_desc
         then ThreadsDomain.AnyThreadButSelf
         else if Procdesc.is_java_synchronized proc_desc || is_marked_thread_safe proc_name tenv

infer/src/concurrency/RacerDModels.ml

@@ -467,3 +467,10 @@ let is_synchronized_container callee_pname (access_exp : HilExp.AccessExpression
           false )
     | _ ->
         false
+
+
+let runs_on_ui_thread ~attrs_of_pname tenv pname =
+  let open ConcurrencyModels in
+  annotated_as_worker_thread ~attrs_of_pname tenv pname |> Option.is_none
+  && ( is_modeled_ui_method tenv pname
+     || annotated_as_uithread_equivalent ~attrs_of_pname tenv pname |> Option.is_some )

infer/src/concurrency/RacerDModels.mli

@@ -52,3 +52,7 @@ val should_flag_interface_call : Tenv.t -> HilExp.t list -> CallFlags.t -> Typ.P
 
 val is_synchronized_container : Typ.Procname.t -> HilExp.AccessExpression.t -> Tenv.t -> bool
 (** is a call on an access expression to a method of a synchronized container? *)
+
+val runs_on_ui_thread :
+  attrs_of_pname:(Typ.Procname.t -> ProcAttributes.t option) -> Tenv.t -> Typ.Procname.t -> bool
+(** is method not transitively annotated @WorkerThread and is modeled or annotated @UIThread or equivalent? *)

infer/src/concurrency/StarvationModels.ml

@@ -190,3 +190,18 @@ let strict_mode_matcher =
 
 let is_strict_mode_violation tenv pn actuals =
   Config.starvation_strict_mode && strict_mode_matcher tenv pn actuals
+
+
+type uithread_explanation =
+  | IsModeled of {proc_name: Typ.Procname.t}
+  | CallsModeled of {proc_name: Typ.Procname.t; callee: Typ.Procname.t}
+  | Annotated of {proc_name: Typ.Procname.t; trail: ConcurrencyModels.annotation_trail}
+[@@deriving compare]
+
+let get_uithread_explanation ~attrs_of_pname tenv proc_name =
+  let open ConcurrencyModels in
+  if annotated_as_worker_thread ~attrs_of_pname tenv proc_name |> Option.is_some then None
+  else if is_modeled_ui_method tenv proc_name then Some (IsModeled {proc_name})
+  else
+    annotated_as_uithread_equivalent ~attrs_of_pname tenv proc_name
+    |> Option.map ~f:(fun trail -> Annotated {proc_name; trail})

infer/src/concurrency/StarvationModels.mli

@@ -23,3 +23,15 @@ val is_synchronized_library_call : Tenv.t -> Typ.Procname.t -> bool
 
 val should_skip_analysis : Tenv.t -> Typ.Procname.t -> HilExp.t list -> bool
 (** should we treat a method call as skip (eg library methods in guava) to avoid FPs? *)
+
+type uithread_explanation =
+  | IsModeled of {proc_name: Typ.Procname.t}
+  | CallsModeled of {proc_name: Typ.Procname.t; callee: Typ.Procname.t}
+  | Annotated of {proc_name: Typ.Procname.t; trail: ConcurrencyModels.annotation_trail}
+[@@deriving compare]
+
+val get_uithread_explanation :
+     attrs_of_pname:(Typ.Procname.t -> ProcAttributes.t option)
+  -> Tenv.t
+  -> Typ.Procname.t
+  -> uithread_explanation option

infer/src/concurrency/starvation.ml

@@ -13,6 +13,8 @@ let pname_pp = MF.wrap_monospaced Typ.Procname.pp
 
 let debug fmt = L.(debug Analysis Verbose fmt)
 
+let attrs_of_pname = Summary.OnDisk.proc_resolve_attributes
+
 let is_ui_thread_model pn =
   ConcurrencyModels.(match get_thread pn with MainThread -> true | _ -> false)
 
@@ -117,8 +119,8 @@ module TransferFunctions (CFG : ProcCfg.S) = struct
           let locks = List.hd actuals |> Option.to_list in
           do_lock locks loc astate |> do_unlock locks
       | NoEffect when is_java && is_ui_thread_model callee ->
-          let explanation = F.asprintf "it calls %a" pname_pp callee in
-          Domain.set_on_ui_thread astate ~loc explanation
+          Domain.set_on_ui_thread astate ~loc
+            (Domain.UIThreadElement.CallsModeled {proc_name= procname; callee})
       | NoEffect when is_java && is_strict_mode_violation tenv callee actuals ->
           Domain.strict_mode_call ~callee ~loc astate
       | NoEffect when is_java -> (
@@ -161,8 +163,7 @@ let analyze_procedure {Callbacks.exe_env; summary} =
         StarvationDomain.acquire tenv StarvationDomain.bottom ~procname ~loc (Option.to_list lock)
     in
     let initial =
-      ConcurrencyModels.runs_on_ui_thread ~attrs_of_pname:Summary.OnDisk.proc_resolve_attributes
-        tenv procname
+      StarvationModels.get_uithread_explanation ~attrs_of_pname tenv procname
       |> Option.value_map ~default:initial ~f:(StarvationDomain.set_on_ui_thread initial ~loc)
     in
     let filter_blocks =
@@ -369,8 +370,7 @@ let report_lockless_violations (tenv, summary) StarvationDomain.{critical_pairs}
     let check annot = Annotations.(ia_ends_with annot lockless) in
     let check_attributes pname =
       PatternMatch.check_class_attributes check tenv pname
-      || Annotations.pname_has_return_annot pname
-           ~attrs_of_pname:Summary.OnDisk.proc_resolve_attributes check
+      || Annotations.pname_has_return_annot pname ~attrs_of_pname check
     in
     PatternMatch.override_exists check_attributes tenv pname
   in

infer/src/concurrency/starvationDomain.ml

@@ -358,14 +358,45 @@ module CriticalPairs = struct
       astate empty
 end
 
-module UIThreadExplanationDomain = struct
-  module StringElement = struct
-    include String
+module UIThreadElement = struct
+  type t = StarvationModels.uithread_explanation =
+    | IsModeled of {proc_name: Typ.Procname.t}
+    | CallsModeled of {proc_name: Typ.Procname.t; callee: Typ.Procname.t}
+    | Annotated of {proc_name: Typ.Procname.t; trail: ConcurrencyModels.annotation_trail}
+  [@@deriving compare]
 
-    let describe = pp
+  let mono_pname = MF.wrap_monospaced Typ.Procname.pp
+
+  let describe fmt = function
+    | IsModeled {proc_name} ->
+        F.fprintf fmt "%a is a standard UI-thread method" mono_pname proc_name
+    | CallsModeled {proc_name= _; callee} ->
+        F.fprintf fmt "it calls %a" pname_pp callee
+    | Annotated {proc_name; trail= DirectlyAnnotated} ->
+        F.fprintf fmt "%a is annotated %a" mono_pname proc_name MF.pp_monospaced
+          Annotations.ui_thread
+    | Annotated {proc_name; trail= Override override_pname} ->
+        F.fprintf fmt "class %a overrides %a, which is annotated %a" mono_pname proc_name
+          mono_pname override_pname MF.pp_monospaced Annotations.ui_thread
+    | Annotated {proc_name; trail= SuperClass class_name} -> (
+      match Typ.Procname.get_class_type_name proc_name with
+      | None ->
+          L.die InternalError "Cannot get class of method %a@." Typ.Procname.pp proc_name
+      | Some current_class ->
+          let pp_extends fmt current_class =
+            if Typ.Name.equal current_class class_name then ()
+            else F.fprintf fmt " extends %a, which" (MF.wrap_monospaced Typ.Name.pp) class_name
+          in
+          F.fprintf fmt "class %s%a is annotated %a"
+            (MF.monospaced_to_string (Typ.Name.name current_class))
+            pp_extends current_class MF.pp_monospaced Annotations.ui_thread )
+
+
+  let pp = describe
 end
 
-  include ExplicitTrace.MakeTraceElem (StringElement) (ExplicitTrace.DefaultCallPrinter)
+module UIThreadExplanationDomain = struct
+  include ExplicitTrace.MakeTraceElem (UIThreadElement) (ExplicitTrace.DefaultCallPrinter)
 
   let join lhs rhs = if List.length lhs.trace <= List.length rhs.trace then lhs else rhs
 
@@ -443,11 +474,9 @@ let ( <= ) ~lhs ~rhs =
   && UIThreadDomain.( <= ) ~lhs:lhs.ui ~rhs:rhs.ui
 
 
-(* for every lock b held locally, add a pair (b, event) *)
 let add_critical_pair tenv_opt lock_state event ~loc acc =
   if should_skip tenv_opt event lock_state then acc
   else
-    (* FIXME we should not do this repeatedly in the fold below *)
     let acquisitions = LockState.get_acquisitions lock_state in
     let critical_pair = CriticalPair.make ~loc acquisitions event in
     CriticalPairs.add critical_pair acc
@@ -455,7 +484,6 @@ let add_critical_pair tenv_opt lock_state event ~loc acc =
 
 let acquire tenv ({lock_state; critical_pairs} as astate) ~procname ~loc locks =
   { astate with
-    (* FIXME do one fold not two *)
     critical_pairs=
       List.fold locks ~init:critical_pairs ~f:(fun acc lock ->
           let event = Event.make_acquire lock in

infer/src/concurrency/starvationDomain.mli

@@ -71,8 +71,15 @@ end
 
 module CriticalPairs : AbstractDomain.FiniteSetS with type elt = CriticalPair.t
 
+module UIThreadElement : sig
+  type t = StarvationModels.uithread_explanation =
+    | IsModeled of {proc_name: Typ.Procname.t}
+    | CallsModeled of {proc_name: Typ.Procname.t; callee: Typ.Procname.t}
+    | Annotated of {proc_name: Typ.Procname.t; trail: ConcurrencyModels.annotation_trail}
+end
+
 module UIThreadExplanationDomain : sig
-  include ExplicitTrace.TraceElem with type elem_t = string
+  include ExplicitTrace.TraceElem
 
   val make_trace : ?header:string -> Typ.Procname.t -> t -> Errlog.loc_trace
 end
@@ -101,8 +108,8 @@ val blocking_call : callee:Typ.Procname.t -> StarvationModels.severity -> loc:Lo
 
 val strict_mode_call : callee:Typ.Procname.t -> loc:Location.t -> t -> t
 
-val set_on_ui_thread : t -> loc:Location.t -> string -> t
-(** set the property "runs on UI thread" to true by attaching the given explanation string as to
+val set_on_ui_thread : t -> loc:Location.t -> UIThreadElement.t -> t
+(** set the property "runs on UI thread" to true by attaching the given explanation as to
     why this method is thought to do so *)
 
 val add_guard :