diff --git a/infer/src/absint/PatternMatch.ml b/infer/src/absint/PatternMatch.ml index f9f06592f..fc7012629 100644 --- a/infer/src/absint/PatternMatch.ml +++ b/infer/src/absint/PatternMatch.ml @@ -116,66 +116,76 @@ let java_get_const_type_name (const: Const.t) : string = let get_vararg_type_names tenv (call_node: Procdesc.Node.t) (ivar: Pvar.t) : string list = (* Is this the node creating ivar? *) - let rec initializes_array instrs = - match instrs with - | Sil.Call ((t1, _), Exp.Const (Const.Cfun pn), _, _, _) - :: Sil.Store (Exp.Lvar iv, _, Exp.Var t2, _) :: is -> - Pvar.equal ivar iv && Ident.equal t1 t2 - && Typ.Procname.equal pn (Typ.Procname.from_string_c_fun "__new_array") - || initializes_array is - | _ :: is -> - initializes_array is - | _ -> - false + let initializes_array instrs = + instrs + |> List.find_map ~f:(function + | Sil.Store (Exp.Lvar iv, _, Exp.Var t2, _) when Pvar.equal ivar iv -> + Some t2 + | _ -> + None ) + |> Option.exists ~f:(fun t2 -> + List.exists instrs ~f:(function + | Sil.Call ((t1, _), Exp.Const (Const.Cfun pn), _, _, _) -> + Ident.equal t1 t2 + && Typ.Procname.equal pn (Typ.Procname.from_string_c_fun "__new_array") + | _ -> + false ) ) in (* Get the type name added to ivar or None *) - let added_type_name node = - let rec nvar_type_name nvar instrs = - match instrs with - | Sil.Load (nv, Exp.Lfield (_, id, t), _, _) :: _ when Ident.equal nv nvar -> - get_field_type_name tenv t id - | Sil.Load (nv, _, t, _) :: _ when Ident.equal nv nvar -> - Some (get_type_name t) - | _ :: is -> - nvar_type_name nvar is - | _ -> - None + let added_type_name instrs = + let nvar_type_name nvar = + instrs + |> List.find_map ~f:(function + | Sil.Load (nv, e, t, _) when Ident.equal nv nvar -> + Some (e, t) + | _ -> + None ) + |> Option.bind ~f:(function + | Exp.Lfield (_, id, t), _ -> + get_field_type_name tenv t id + | _, t -> + Some (get_type_name t) ) in - let rec added_nvar array_nvar instrs = - match instrs with - | Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Var nvar, _) :: _ - when Ident.equal iv array_nvar -> - nvar_type_name nvar (Procdesc.Node.get_instrs node) - | Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Const c, _) :: _ - when Ident.equal iv array_nvar -> - Some (java_get_const_type_name c) - | _ :: is -> - added_nvar array_nvar is - | _ -> - None + let added_nvar array_nvar = + instrs + |> List.find_map ~f:(function + | Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Var nvar, _) + when Ident.equal iv array_nvar -> + Some (nvar_type_name nvar) + | Sil.Store (Exp.Lindex (Exp.Var iv, _), _, Exp.Const c, _) + when Ident.equal iv array_nvar -> + Some (Some (java_get_const_type_name c)) + | _ -> + None ) + |> Option.join in - let rec array_nvar instrs = - match instrs with - | Sil.Load (nv, Exp.Lvar iv, _, _) :: _ when Pvar.equal iv ivar -> - added_nvar nv instrs - | _ :: is -> - array_nvar is - | _ -> - None + let array_nvar = + instrs + |> List.find_map ~f:(function + | Sil.Load (nv, Exp.Lvar iv, _, _) when Pvar.equal iv ivar -> + Some nv + | _ -> + None ) + |> Option.bind ~f:added_nvar in - array_nvar (Procdesc.Node.get_instrs node) + array_nvar in (* Walk nodes backward until definition of ivar, adding type names *) - let rec type_names node = - if initializes_array (Procdesc.Node.get_instrs node) then [] + let rec type_names acc node = + let instrs = Procdesc.Node.get_instrs node in + if initializes_array instrs then acc else match Procdesc.Node.get_preds node with | [n] -> ( - match added_type_name node with Some name -> name :: type_names n | None -> type_names n ) + match added_type_name instrs with + | Some name -> + type_names (name :: acc) n + | None -> + type_names acc n ) | _ -> raise Caml.Not_found in - List.rev (type_names call_node) + type_names [] call_node let is_getter pname_java = diff --git a/infer/src/checkers/printfArgs.ml b/infer/src/checkers/printfArgs.ml index 1ef6fe171..1874f75e0 100644 --- a/infer/src/checkers/printfArgs.ml +++ b/infer/src/checkers/printfArgs.ml @@ -136,25 +136,25 @@ let check_printf_args_ok tenv (node: Procdesc.Node.t) (instr: Sil.instr) Reporting.log_error summary ~loc:instr_loc exn in (* Get the array ivar for a given nvar *) - let rec array_ivar instrs nvar = - match (instrs, nvar) with - | Sil.Load (id, Exp.Lvar iv, _, _) :: _, Exp.Var nid when Ident.equal id nid -> - iv - | _ :: is, _ -> - array_ivar is nvar + let array_ivar instrs nvar = + match nvar with + | Exp.Var nid -> + List.find_map_exn instrs ~f:(function + | Sil.Load (id, Exp.Lvar iv, _, _) when Ident.equal id nid -> + Some iv + | _ -> + None ) | _ -> raise Caml.Not_found in - let rec fixed_nvar_type_name instrs nvar = + let fixed_nvar_type_name instrs nvar = match nvar with - | Exp.Var nid -> ( - match instrs with - | Sil.Load (id, Exp.Lvar _, t, _) :: _ when Ident.equal id nid -> - PatternMatch.get_type_name t - | _ :: is -> - fixed_nvar_type_name is nvar - | _ -> - raise Caml.Not_found ) + | Exp.Var nid -> + List.find_map_exn instrs ~f:(function + | Sil.Load (id, Exp.Lvar _, t, _) when Ident.equal id nid -> + Some (PatternMatch.get_type_name t) + | _ -> + None ) | Exp.Const c -> PatternMatch.java_get_const_type_name c | _ ->