diff --git a/infer/src/checkers/accessPath.ml b/infer/src/checkers/accessPath.ml index d2b83e5c7..e0c6a55a0 100644 --- a/infer/src/checkers/accessPath.ml +++ b/infer/src/checkers/accessPath.ml @@ -67,11 +67,41 @@ let compare ap1 ap2 = match ap1, ap2 with let equal ap1 ap2 = compare ap1 ap2 = 0 +let base_of_pvar pvar typ = + Var.of_pvar pvar, typ + +let base_of_id id typ = + Var.of_id id, typ + let of_pvar pvar typ = - (Var.of_pvar pvar, typ), [] + base_of_pvar pvar typ, [] let of_id id typ = - (Var.of_id id, typ), [] + base_of_id id typ, [] + +let of_exp exp typ ~(f_resolve_id : Ident.t -> raw option) = + (* [typ] is the type of the last element of the access path (e.g., typeof(g) for x.f.g) *) + let rec of_exp_ exp typ accesses = + match exp with + | Sil.Var id -> + begin + match f_resolve_id id with + | Some (base, base_accesses) -> Some (base, base_accesses @ accesses) + | None -> Some (base_of_id id typ, accesses) + end + | Sil.Lvar pvar -> + Some (base_of_pvar pvar typ, accesses) + | Sil.Lfield (root_exp, fld, root_exp_typ) -> + let field_access = FieldAccess (fld, typ) in + of_exp_ root_exp root_exp_typ (field_access :: accesses) + | Sil.Lindex (root_exp, _) -> + let array_access = ArrayAccess typ in + let array_typ = Typ.Tarray (typ, None) in + of_exp_ root_exp array_typ (array_access :: accesses) + | _ -> + (* trying to make access path from an invalid expression (e.g., a constant) *) + None in + of_exp_ exp typ [] let append (base, accesses) access = base, accesses @ [access] diff --git a/infer/src/checkers/accessPath.mli b/infer/src/checkers/accessPath.mli index 53babd924..1cb14eef5 100644 --- a/infer/src/checkers/accessPath.mli +++ b/infer/src/checkers/accessPath.mli @@ -35,12 +35,21 @@ val access_compare : access -> access -> int val access_equal : access -> access -> bool +(** create a base from a pvar *) +val base_of_pvar : Pvar.t -> Typ.t -> base + +(** create a base from an ident *) +val base_of_id : Ident.t -> Typ.t -> base + (** create an access path from a pvar *) val of_pvar : Pvar.t -> Typ.t -> raw (** create an access path from an ident *) val of_id : Ident.t -> Typ.t -> raw +(** convert [exp] to a raw access path, resolving identifiers using [f_resolve_id] *) +val of_exp : Sil.exp -> Typ.t -> f_resolve_id:(Ident.t -> raw option) -> raw option + (** append a new access to an existing access path; e.g., `append_access g x.f` produces `x.f.g` *) val append : raw -> access -> raw diff --git a/infer/src/unit/accessPathTestUtils.ml b/infer/src/unit/accessPathTestUtils.ml index e5fb78992..b7d757c02 100644 --- a/infer/src/unit/accessPathTestUtils.ml +++ b/infer/src/unit/accessPathTestUtils.ml @@ -7,14 +7,20 @@ * of patent rights can be found in the PATENTS file in the same directory. *) -let make_base base_str = - Var.of_pvar (Pvar.mk (Mangled.from_string base_str) Procname.empty_block), Typ.Tvoid +let make_var var_str = + Pvar.mk (Mangled.from_string var_str) Procname.empty_block + +let make_base ?(typ=Typ.Tvoid) base_str = + AccessPath.base_of_pvar (make_var base_str) typ + +let make_fieldname fld_str = + Ident.create_fieldname (Mangled.from_string fld_str) 0 let make_field_access access_str = - AccessPath.FieldAccess (Ident.create_fieldname (Mangled.from_string access_str) 0, Typ.Tvoid) + AccessPath.FieldAccess (make_fieldname access_str, Typ.Tvoid) -let make_array_access () = - AccessPath.ArrayAccess Typ.Tvoid +let make_array_access typ = + AccessPath.ArrayAccess typ let make_access_path base_str access_strs = make_base base_str, IList.map make_field_access access_strs diff --git a/infer/src/unit/accessPathTestUtils.mli b/infer/src/unit/accessPathTestUtils.mli index ce48da573..cbbf91bb9 100644 --- a/infer/src/unit/accessPathTestUtils.mli +++ b/infer/src/unit/accessPathTestUtils.mli @@ -7,10 +7,14 @@ * of patent rights can be found in the PATENTS file in the same directory. *) -val make_base : string -> AccessPath.base +val make_var : string -> Pvar.t + +val make_fieldname : string -> Ident.fieldname + +val make_base : ?typ:Typ.t -> string -> AccessPath.base val make_field_access : string -> AccessPath.access -val make_array_access : unit -> AccessPath.access +val make_array_access : Typ.t -> AccessPath.access val make_access_path : string -> string list -> AccessPath.raw diff --git a/infer/src/unit/accessPathTests.ml b/infer/src/unit/accessPathTests.ml index ba4e431dd..9888bd3ed 100644 --- a/infer/src/unit/accessPathTests.ml +++ b/infer/src/unit/accessPathTests.ml @@ -20,6 +20,11 @@ let tests = let xF = make_access_path "x" ["f"] in let xFG = make_access_path "x" ["f"; "g";] in let yF = make_access_path "y" ["f"] in + let xArr = + let dummy_typ = Typ.Tvoid in + let dummy_arr_typ = Typ.Tarray (dummy_typ, None) in + let base = make_base "x" ~typ:dummy_arr_typ in + base, [make_array_access dummy_typ] in let x_exact = AccessPath.Exact x in let y_exact = AccessPath.Exact y in @@ -67,6 +72,45 @@ let tests = assert_bool "y.f is not prefix of x.f.g" (not (AccessPath.is_prefix yF xFG)) in "prefix">::prefix_test_ in + let of_exp_test = + let f_resolve_id _ = None in + let dummy_typ = Typ.Tvoid in + + let check_make_ap exp expected_ap ~f_resolve_id = + let make_ap exp = + match AccessPath.of_exp exp dummy_typ ~f_resolve_id with + | Some ap -> ap + | None -> assert false in + let actual_ap = make_ap exp in + let pp_diff fmt (actual_ap, expected_ap) = + F.fprintf + fmt + "Expected to make access path %a from expression %a, but got %a" + AccessPath.pp_raw expected_ap + (Sil.pp_exp pe_text) exp + AccessPath.pp_raw actual_ap in + assert_equal ~cmp:AccessPath.raw_equal ~pp_diff actual_ap expected_ap in + + let of_exp_test_ _ = + let f_fieldname = make_fieldname "f" in + let g_fieldname = make_fieldname "g" in + let x_exp = Sil.Lvar (make_var "x") in + check_make_ap x_exp x ~f_resolve_id; + let xF_exp = Sil.Lfield (x_exp, f_fieldname, dummy_typ) in + check_make_ap xF_exp xF ~f_resolve_id; + let xFG_exp = Sil.Lfield (xF_exp, g_fieldname, dummy_typ) in + check_make_ap xFG_exp xFG ~f_resolve_id; + let xArr_exp = Sil.Lindex (x_exp, Sil.exp_zero) in + check_make_ap xArr_exp xArr ~f_resolve_id; + (* make sure [f_resolve_id] works *) + let f_resolve_id_to_xF _ = Some xF in + let xFG_exp_with_id = + let id_exp = Sil.Var (Ident.create_normal (Ident.string_to_name "") 0) in + Sil.Lfield (id_exp, g_fieldname, dummy_typ) in + check_make_ap xFG_exp_with_id xFG ~f_resolve_id:f_resolve_id_to_xF; + () in + "of_exp">::of_exp_test_ in + let abstraction_test = let abstraction_test_ _ = assert_bool "extract" (AccessPath.raw_equal (AccessPath.extract xF_exact) xF); @@ -134,4 +178,11 @@ let tests = assert_eq (AccessPathDomains.Set.normalize aps3) "{ &x*, &y.f }" in "domain">::domain_test_ in - "all_tests_suite">:::[equal_test; append_test; prefix_test; abstraction_test; domain_test] + "all_tests_suite">:::[ + equal_test; + append_test; + prefix_test; + of_exp_test; + abstraction_test; + domain_test + ] diff --git a/infer/src/unit/accessTreeTests.ml b/infer/src/unit/accessTreeTests.ml index acf522f35..96e9af138 100644 --- a/infer/src/unit/accessTreeTests.ml +++ b/infer/src/unit/accessTreeTests.ml @@ -41,7 +41,7 @@ let tests = let f = make_field_access "f" in let g = make_field_access "g" in - let array = make_array_access () in + let array = make_array_access Typ.Tvoid in let x = AccessPath.Exact (make_access_path "x" []) in let xF = AccessPath.Exact (make_access_path "x" ["f"]) in