From fbf0020399c5deaea22a14702c5080156c111350 Mon Sep 17 00:00:00 2001 From: Dulma Churchill Date: Tue, 13 Feb 2018 03:05:10 -0800 Subject: [PATCH] [retain cycles] Fix the order of the cycles, refactor dfs Reviewed By: mbouaziz Differential Revision: D6952739 fbshipit-source-id: cfd8dd0 --- infer/src/backend/RetainCycles.ml | 83 +++++++++++++------------- infer/src/backend/RetainCyclesType.ml | 57 ++++++++++++------ infer/src/backend/RetainCyclesType.mli | 4 ++ 3 files changed, 87 insertions(+), 57 deletions(-) diff --git a/infer/src/backend/RetainCycles.ml b/infer/src/backend/RetainCycles.ml index e95f96ae9..2de957861 100644 --- a/infer/src/backend/RetainCycles.ml +++ b/infer/src/backend/RetainCycles.ml @@ -50,6 +50,22 @@ let desc_retain_cycle tenv (cycle: RetainCyclesType.t) = List.fold_left cycle_str ~f:(fun acc s -> Format.sprintf "%s\n %s" acc s) ~init:"" +let get_cycle_blocks root_node exp = + match exp with + | Exp.Closure {name; captured_vars} -> + List.find + ~f:(fun (e, _, typ) -> + match typ.Typ.desc with + | Typ.Tptr (_, Typ.Pk_objc_weak) | Typ.Tptr (_, Typ.Pk_objc_unsafe_unretained) -> + false + | _ -> + Exp.equal e root_node.RetainCyclesType.rc_node_exp ) + captured_vars + |> Option.map ~f:(fun (_, var, _) -> (name, var)) + | _ -> + None + + let get_cycle root prop = let open RetainCyclesType in let sigma = prop.Prop.sigma in @@ -61,63 +77,48 @@ let get_cycle root prop = (* Perform a dfs of a graph stopping when e_root is reached. Returns a pair (path, bool) where path is a list of edges describing the path to e_root and bool is true if e_root is reached. *) - let rec dfs root_node from_node path fields visited = - let get_cycle_blocks exp = - match exp with - | Exp.Closure {name; captured_vars} -> - List.find - ~f:(fun (e, _, typ) -> - match typ.Typ.desc with - | Typ.Tptr (_, Typ.Pk_objc_weak) | Typ.Tptr (_, Typ.Pk_objc_unsafe_unretained) -> - false - | _ -> - Exp.equal e root_node.rc_node_exp ) - captured_vars - |> Option.map ~f:(fun (_, var, _) -> (name, var)) - | _ -> - None - in + let rec dfs ~root_node ~from_node ~rev_path ~fields ~visited = match fields with | [] -> - (path, false) + (rev_path, false) | (field, Sil.Eexp (f_exp, f_inst)) :: el' -> + (* found root, finish the cycle *) if Exp.equal f_exp root_node.rc_node_exp then let rc_field = {rc_field_name= field; rc_field_inst= f_inst} in let edge = Object {rc_from= from_node; rc_field} in - (edge :: path, true) + (edge :: rev_path, true) (* we already visited f_exp, stop *) + else if List.mem ~equal:Exp.equal visited f_exp then (rev_path, false) else - let cycle_block_opt = get_cycle_blocks f_exp in + let visited' = from_node.rc_node_exp :: visited in + let cycle_block_opt = get_cycle_blocks root_node f_exp in + (* cycle with a block *) if Option.is_some cycle_block_opt then - match cycle_block_opt with - | Some (procname, var) -> - let rc_field = {rc_field_name= field; rc_field_inst= f_inst} in - (* From the captured variables we get the actual name of the variable - that is more useful for the error message *) - let updated_from_node = {from_node with rc_node_exp= Exp.Lvar var} in - let edge1 = Object {rc_from= updated_from_node; rc_field} in - let edge2 = Block procname in - (edge1 :: edge2 :: path, true) - | None -> - assert false - else if List.mem ~equal:Exp.equal visited f_exp then (path, false) + let procname, var = Option.value_exn cycle_block_opt in + let rc_field = {rc_field_name= field; rc_field_inst= f_inst} in + (* From the captured variables we get the actual name of the variable + that is more useful for the error message *) + let updated_from_node = {from_node with rc_node_exp= Exp.Lvar var} in + let edge1 = Object {rc_from= updated_from_node; rc_field} in + let edge2 = Block procname in + (edge2 :: edge1 :: rev_path, true) else - let visited' = from_node.rc_node_exp :: visited in let res = match get_points_to f_exp with | None -> - (path, false) + (rev_path, false) | Some Sil.Hpointsto (_, Sil.Estruct (new_fields, _), Exp.Sizeof {typ= te}) -> let rc_field = {rc_field_name= field; rc_field_inst= f_inst} in let edge = Object {rc_from= from_node; rc_field} in let rc_to = {rc_node_exp= f_exp; rc_node_typ= te} in - dfs root_node rc_to (edge :: path) new_fields visited' + dfs ~root_node ~from_node:rc_to ~rev_path:(edge :: rev_path) ~fields:new_fields + ~visited:visited' | _ -> - (path, false) - (* check for lists *) + (rev_path, false) in - if snd res then res else dfs root_node from_node path el' visited' + if snd res then res + else dfs ~root_node ~from_node ~rev_path ~fields:el' ~visited:visited' | _ -> - (path, false) + (rev_path, false) in L.d_strln "Looking for cycle with root expression: " ; Sil.d_hpred root ; @@ -126,8 +127,10 @@ let get_cycle root prop = | Sil.Hpointsto (e_root, Sil.Estruct (fl, _), Exp.Sizeof {typ= te}) -> let se_root = {rc_node_exp= e_root; rc_node_typ= te} in (* start dfs with empty path and expr pointing to root *) - let pot_cycle, res = dfs se_root se_root [] fl [] in - if res then pot_cycle + let pot_cycle, res = + dfs ~root_node:se_root ~from_node:se_root ~rev_path:[] ~fields:fl ~visited:[] + in + if res then List.rev pot_cycle else ( L.d_strln "NO cycle found from root" ; [] ) diff --git a/infer/src/backend/RetainCyclesType.ml b/infer/src/backend/RetainCyclesType.ml index ab439b471..160b5b25e 100644 --- a/infer/src/backend/RetainCyclesType.ml +++ b/infer/src/backend/RetainCyclesType.ml @@ -23,6 +23,8 @@ type retain_cycle_edge = | Block of Typ.Procname.t [@@deriving compare] +let retain_cycle_edge_equal = [%compare.equal : retain_cycle_edge] + type t = {rc_elements: retain_cycle_edge list; rc_head: retain_cycle_edge} [@@deriving compare] let is_inst_rearrange node = @@ -33,20 +35,7 @@ let is_inst_rearrange node = false -let create_cycle cycle = - let sorted_cycle = List.sort ~cmp:compare_retain_cycle_edge cycle in - match sorted_cycle with - | [hd] -> - if is_inst_rearrange hd then (* cycles of length 1 created at rearrange are not real *) - None - else Some {rc_elements= sorted_cycle; rc_head= hd} - | hd :: _ -> - Some {rc_elements= sorted_cycle; rc_head= hd} - | [] -> - None - - -let retain_cycle_node_to_string (node: retain_cycle_node) = +let _retain_cycle_node_to_string (node: retain_cycle_node) = Format.sprintf "%s : %s" (Exp.to_string node.rc_node_exp) (Typ.to_string node.rc_node_typ) @@ -56,11 +45,11 @@ let retain_cycle_field_to_string (field: retain_cycle_field_objc) = (Sil.inst_to_string field.rc_field_inst) -let retain_cycle_edge_to_string (edge: retain_cycle_edge) = +let _retain_cycle_edge_to_string (edge: retain_cycle_edge) = match edge with | Object obj -> Format.sprintf "%s ->{%s}" - (retain_cycle_node_to_string obj.rc_from) + (_retain_cycle_node_to_string obj.rc_from) (retain_cycle_field_to_string obj.rc_field) | Block _ -> Format.sprintf "a block" @@ -68,11 +57,45 @@ let retain_cycle_edge_to_string (edge: retain_cycle_edge) = let retain_cycle_to_string cycle = "Cycle= \n\t" - ^ String.concat ~sep:"->" (List.map ~f:retain_cycle_edge_to_string cycle.rc_elements) + ^ String.concat ~sep:"->" (List.map ~f:_retain_cycle_edge_to_string cycle.rc_elements) let print_cycle cycle = Logging.d_strln (retain_cycle_to_string cycle) +let find_minimum_element cycle = + List.reduce_exn cycle.rc_elements ~f:(fun el1 el2 -> + if compare_retain_cycle_edge el1 el2 < 0 then el1 else el2 ) + + +let shift cycle head : t = + let rec shift_elements rev_tail elements = + match elements with + | hd :: rest when not (retain_cycle_edge_equal hd head) -> + shift_elements (hd :: rev_tail) rest + | _ -> + elements @ List.rev rev_tail + in + let new_elements = shift_elements [] cycle.rc_elements in + {rc_elements= new_elements; rc_head= List.hd_exn new_elements} + + +let normalize_cycle cycle = + let min = find_minimum_element cycle in + shift cycle min + + +let create_cycle cycle = + match cycle with + | [hd] -> + if is_inst_rearrange hd then (* cycles of length 1 created at rearrange are not real *) + None + else Some (normalize_cycle {rc_elements= cycle; rc_head= hd}) + | hd :: _ -> + Some (normalize_cycle {rc_elements= cycle; rc_head= hd}) + | [] -> + None + + let pp_dotty fmt cycle = let pp_dotty_obj fmt element = match element with diff --git a/infer/src/backend/RetainCyclesType.mli b/infer/src/backend/RetainCyclesType.mli index 5006e2c5b..06bee2c78 100644 --- a/infer/src/backend/RetainCyclesType.mli +++ b/infer/src/backend/RetainCyclesType.mli @@ -29,3 +29,7 @@ val create_cycle : retain_cycle_edge list -> t option val pp_dotty : Format.formatter -> t -> unit val write_dotty_to_file : string -> t -> unit + +val _retain_cycle_edge_to_string : retain_cycle_edge -> string + +val _retain_cycle_node_to_string : retain_cycle_node -> string