[starvation] refactor event type with records

Summary: Subsequent diff will push information down into `Event.t` so as preparation, turn all variant values into records.

Reviewed By: jvillard

Differential Revision: D24115201

fbshipit-source-id: d2126dd49
master
Nikos Gorogiannis 4 years ago committed by Facebook GitHub Bot
parent 8df1f12213
commit d36dbca2fd

@ -75,7 +75,7 @@ let report exe_env work_set =
tenv pattrs pair acc tenv pattrs pair acc
in in
match pair.elem.event with match pair.elem.event with
| LockAcquire locks -> | LockAcquire {locks} ->
List.fold locks ~init:acc ~f:(fun acc lock -> List.fold locks ~init:acc ~f:(fun acc lock ->
let should_report_starvation = let should_report_starvation =
CriticalPair.is_uithread pair && not (Procname.is_constructor procname) CriticalPair.is_uithread pair && not (Procname.is_constructor procname)

@ -605,7 +605,7 @@ let should_report_deadlock_on_current_proc current_elem endpoint_elem =
(* should never happen *) (* should never happen *)
L.die InternalError "Deadlock cannot occur without two lock events: %a" CriticalPair.pp L.die InternalError "Deadlock cannot occur without two lock events: %a" CriticalPair.pp
current_elem current_elem
| LockAcquire endpoint_locks, LockAcquire current_locks -> ( | LockAcquire {locks= endpoint_locks}, LockAcquire {locks= current_locks} -> (
(* first elem is a class object (see [lock_of_class]), so always report because the (* first elem is a class object (see [lock_of_class]), so always report because the
reverse ordering on the events will not occur since we don't search the class for static locks *) reverse ordering on the events will not occur since we don't search the class for static locks *)
List.exists ~f:Lock.is_class_object endpoint_locks List.exists ~f:Lock.is_class_object endpoint_locks
@ -671,7 +671,7 @@ let report_on_parallel_composition ~should_report_starvation tenv pattrs pair lo
if CriticalPair.can_run_in_parallel pair other_pair then if CriticalPair.can_run_in_parallel pair other_pair then
let acquisitions = other_pair.CriticalPair.elem.acquisitions in let acquisitions = other_pair.CriticalPair.elem.acquisitions in
match other_pair.CriticalPair.elem.event with match other_pair.CriticalPair.elem.event with
| MayBlock (_, sev) as event | MayBlock {severity} as event
when should_report_starvation when should_report_starvation
&& Acquisitions.lock_is_held_in_other_thread tenv lock acquisitions -> && Acquisitions.lock_is_held_in_other_thread tenv lock acquisitions ->
let error_message = let error_message =
@ -680,8 +680,8 @@ let report_on_parallel_composition ~should_report_starvation tenv pattrs pair lo
pname_pp pname Lock.pp_locks lock Event.describe event pname_pp pname Lock.pp_locks lock Event.describe event
in in
let ltr, loc = make_trace_and_loc () in let ltr, loc = make_trace_and_loc () in
ReportMap.add_starvation sev tenv pattrs loc ltr error_message report_map ReportMap.add_starvation severity tenv pattrs loc ltr error_message report_map
| MonitorWait monitor_lock | MonitorWait {lock= monitor_lock}
when should_report_starvation when should_report_starvation
&& Acquisitions.lock_is_held_in_other_thread tenv lock acquisitions && Acquisitions.lock_is_held_in_other_thread tenv lock acquisitions
&& not (Lock.equal lock monitor_lock) -> && not (Lock.equal lock monitor_lock) ->
@ -723,13 +723,13 @@ let report_on_pair ~analyze_ondemand tenv pattrs (pair : Domain.CriticalPair.t)
(ltr, loc) (ltr, loc)
in in
match event with match event with
| MayBlock (_, sev) when should_report_starvation -> | MayBlock {severity} when should_report_starvation ->
let error_message = let error_message =
Format.asprintf "Method %a runs on UI thread and may block; %a." pname_pp pname Format.asprintf "Method %a runs on UI thread and may block; %a." pname_pp pname
Event.describe event Event.describe event
in in
let ltr, loc = make_trace_and_loc () in let ltr, loc = make_trace_and_loc () in
ReportMap.add_starvation sev tenv pattrs loc ltr error_message report_map ReportMap.add_starvation severity tenv pattrs loc ltr error_message report_map
| MonitorWait _ when should_report_starvation -> | MonitorWait _ when should_report_starvation ->
let error_message = let error_message =
Format.asprintf "Method %a runs on UI thread and may block; %a." pname_pp pname Format.asprintf "Method %a runs on UI thread and may block; %a." pname_pp pname
@ -753,7 +753,7 @@ let report_on_pair ~analyze_ondemand tenv pattrs (pair : Domain.CriticalPair.t)
let loc = CriticalPair.get_earliest_lock_or_call_loc ~procname:pname pair in let loc = CriticalPair.get_earliest_lock_or_call_loc ~procname:pname pair in
let ltr = CriticalPair.make_trace pname pair in let ltr = CriticalPair.make_trace pname pair in
ReportMap.add_lockless_violation tenv pattrs loc ltr error_message report_map ReportMap.add_lockless_violation tenv pattrs loc ltr error_message report_map
| LockAcquire locks -> ( | LockAcquire {locks} -> (
match match
List.find locks ~f:(fun lock -> Acquisitions.lock_is_held lock pair.elem.acquisitions) List.find locks ~f:(fun lock -> Acquisitions.lock_is_held lock pair.elem.acquisitions)
with with

@ -177,56 +177,61 @@ end
module Event = struct module Event = struct
type t = type t =
| LockAcquire of Lock.t list | LockAcquire of {locks: Lock.t list}
| MayBlock of (Procname.t * StarvationModels.severity) | MayBlock of {callee: Procname.t; severity: StarvationModels.severity}
| StrictModeCall of Procname.t | StrictModeCall of {callee: Procname.t}
| MonitorWait of Lock.t | MonitorWait of {lock: Lock.t}
[@@deriving compare] [@@deriving compare]
let pp fmt = function let pp fmt = function
| LockAcquire locks -> | LockAcquire {locks} ->
F.fprintf fmt "LockAcquire(%a)" (PrettyPrintable.pp_collection ~pp_item:Lock.pp) locks F.fprintf fmt "LockAcquire(%a)" (PrettyPrintable.pp_collection ~pp_item:Lock.pp) locks
| MayBlock (pname, sev) -> | MayBlock {callee; severity} ->
F.fprintf fmt "MayBlock(%a, %a)" Procname.pp pname StarvationModels.pp_severity sev F.fprintf fmt "MayBlock(%a, %a)" Procname.pp callee StarvationModels.pp_severity severity
| StrictModeCall pname -> | StrictModeCall {callee} ->
F.fprintf fmt "StrictModeCall(%a)" Procname.pp pname F.fprintf fmt "StrictModeCall(%a)" Procname.pp callee
| MonitorWait lock -> | MonitorWait {lock} ->
F.fprintf fmt "MonitorWait(%a)" Lock.pp lock F.fprintf fmt "MonitorWait(%a)" Lock.pp lock
let describe fmt elem = let describe fmt elem =
match elem with match elem with
| LockAcquire locks -> | LockAcquire {locks} ->
Pp.comma_seq Lock.pp_locks fmt locks Pp.comma_seq Lock.pp_locks fmt locks
| MayBlock (pname, _) | StrictModeCall pname -> | MayBlock {callee} | StrictModeCall {callee} ->
F.fprintf fmt "calls %a" describe_pname pname F.fprintf fmt "calls %a" describe_pname callee
| MonitorWait lock -> | MonitorWait {lock} ->
F.fprintf fmt "calls `wait` on %a" Lock.describe lock F.fprintf fmt "calls `wait` on %a" Lock.describe lock
let make_acquire lock = LockAcquire lock let make_acquire locks = LockAcquire {locks}
let make_blocking_call callee sev = MayBlock (callee, sev) let make_blocking_call callee severity = MayBlock {callee; severity}
let make_strict_mode_call callee = StrictModeCall callee let make_strict_mode_call callee = StrictModeCall {callee}
let make_object_wait lock = MonitorWait lock let make_object_wait lock = MonitorWait {lock}
let apply_subst subst event = let apply_subst subst event =
match event with match event with
| MayBlock _ | StrictModeCall _ -> | MayBlock _ | StrictModeCall _ ->
Some event Some event
| MonitorWait lock -> | MonitorWait {lock} -> (
Lock.apply_subst subst lock match Lock.apply_subst subst lock with
|> Option.map ~f:(fun lock' -> if phys_equal lock lock' then event else MonitorWait lock') | None ->
| LockAcquire locks -> ( None
| Some lock' when phys_equal lock lock' ->
Some event
| Some lock ->
Some (MonitorWait {lock}) )
| LockAcquire {locks} -> (
match Lock.apply_subst_to_list subst locks with match Lock.apply_subst_to_list subst locks with
| [] -> | [] ->
None None
| locks' when phys_equal locks locks' -> | locks' when phys_equal locks locks' ->
Some event Some event
| locks' -> | locks ->
Some (LockAcquire locks') ) Some (LockAcquire {locks}) )
end end
(** A lock acquisition with source location and procname in which it occurs. The location & procname (** A lock acquisition with source location and procname in which it occurs. The location & procname
@ -404,7 +409,7 @@ let is_recursive_lock event tenv =
true true
in in
match (event : Event.t) with match (event : Event.t) with
| LockAcquire locks -> | LockAcquire {locks} ->
List.exists locks ~f:(fun lock_path -> List.exists locks ~f:(fun lock_path ->
Lock.get_typ tenv lock_path |> Option.exists ~f:is_class_and_recursive_lock ) Lock.get_typ tenv lock_path |> Option.exists ~f:is_class_and_recursive_lock )
| _ -> | _ ->
@ -420,7 +425,7 @@ module CriticalPair = struct
let may_deadlock tenv ~(lhs : t) ~lhs_lock ~(rhs : t) = let may_deadlock tenv ~(lhs : t) ~lhs_lock ~(rhs : t) =
let get_acquired_locks {elem= {event}} = let get_acquired_locks {elem= {event}} =
match event with LockAcquire locks -> locks | _ -> [] match event with LockAcquire {locks} -> locks | _ -> []
in in
if ThreadDomain.can_run_in_parallel lhs.elem.thread rhs.elem.thread then if ThreadDomain.can_run_in_parallel lhs.elem.thread rhs.elem.thread then
get_acquired_locks rhs get_acquired_locks rhs
@ -445,7 +450,7 @@ module CriticalPair = struct
[held_locks] *) [held_locks] *)
let filter_out_reentrant_relocks tenv_opt held_locks pair = let filter_out_reentrant_relocks tenv_opt held_locks pair =
match (tenv_opt, pair.elem.event) with match (tenv_opt, pair.elem.event) with
| Some tenv, LockAcquire locks -> ( | Some tenv, LockAcquire {locks} -> (
let filtered_locks = let filtered_locks =
IList.filter_changed locks ~f:(fun lock -> IList.filter_changed locks ~f:(fun lock ->
(not (Acquisitions.lock_is_held lock held_locks)) (not (Acquisitions.lock_is_held lock held_locks))
@ -456,8 +461,8 @@ module CriticalPair = struct
None None
| _ when phys_equal filtered_locks locks -> | _ when phys_equal filtered_locks locks ->
Some pair Some pair
| _ -> | locks ->
Some (map pair ~f:(fun elem -> {elem with event= LockAcquire filtered_locks})) ) Some (map pair ~f:(fun elem -> {elem with event= LockAcquire {locks}})) )
| _, _ -> | _, _ ->
Some pair Some pair

@ -57,10 +57,10 @@ end
module Event : sig module Event : sig
type t = type t =
| LockAcquire of Lock.t list | LockAcquire of {locks: Lock.t list}
| MayBlock of (Procname.t * StarvationModels.severity) | MayBlock of {callee: Procname.t; severity: StarvationModels.severity}
| StrictModeCall of Procname.t | StrictModeCall of {callee: Procname.t}
| MonitorWait of Lock.t | MonitorWait of {lock: Lock.t}
[@@deriving compare] [@@deriving compare]
val describe : F.formatter -> t -> unit val describe : F.formatter -> t -> unit

Loading…
Cancel
Save