create access paths from expressions

Reviewed By: jvillard

Differential Revision: D3605422

fbshipit-source-id: 1ccd9f8

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]

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
 

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

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

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
+  ]

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