pghs975uc
/
infer_clone
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Extract the naming of types to its own module named Typename

Browse Source 
Summary:
public
Move the naming of types to it own module, so that it can be used by modules `Sil` depends from like `Procname`

Reviewed By: jberdine

Differential Revision: D2773148

fb-gh-sync-id: a89f595
master
jrm 9 years ago committed by facebook-github-bot-5
parent 4143d4eb2d
commit 2e7f5735d3
30 changed files with 159 additions and 140 deletions
Show Stats Download Patch File Download Diff File

18
infer/src/backend/abs.ml
Unescape View File

@ -411,7 +411,7 @@ let typ_get_recursive_flds tenv te =
| Sil.Tptr (Sil.Tvar tname', _) ->
let typ' = match Sil.tenv_lookup tenv tname' with
| None ->
L.err "@.typ_get_recursive: Undefined type %s@." (Sil.typename_to_string tname');
L.err "@.typ_get_recursive: Undefined type %s@." (Typename.to_string tname');
t
| Some typ' -> typ' in
Sil.exp_equal te (Sil.Sizeof (typ', Sil.Subtype.exact))
@ -761,7 +761,7 @@ let is_simply_recursive tenv tname =
| Sil.Tvar _ | Sil.Tint _ | Sil.Tfloat _ | Sil.Tvoid | Sil.Tfun _ | Sil.Tenum _ ->
false
| Sil.Tptr (Sil.Tvar tname', _) ->
Sil.typename_equal tname tname'
Typename.equal tname tname'
| Sil.Tptr _ | Sil.Tstruct _ | Sil.Tarray _ ->
false in
match typ with
@ -900,29 +900,29 @@ let create_hpara_dll_from_tname_twoflds_hpara tenv tname fld_flink fld_blink fld
let body = [ptsto; lseg] in
Prop.mk_dll_hpara id_cell id_blink id_flink [] [id_down] body
let tname_list = Sil.TN_typedef (Mangled.from_string "list")
let tname_list = Typename.TN_typedef (Mangled.from_string "list")
let name_down = Ident.create_fieldname (Mangled.from_string "down") 0
let tname_HSlist2 = Sil.TN_typedef (Mangled.from_string "HSlist2")
let tname_HSlist2 = Typename.TN_typedef (Mangled.from_string "HSlist2")
let name_next = Ident.create_fieldname (Mangled.from_string "next") 0
let tname_dllist = Sil.TN_typedef (Mangled.from_string "dllist")
let tname_dllist = Typename.TN_typedef (Mangled.from_string "dllist")
let name_Flink = Ident.create_fieldname (Mangled.from_string "Flink") 0
let name_Blink = Ident.create_fieldname (Mangled.from_string "Blink") 0
let tname_HOdllist = Sil.TN_typedef (Mangled.from_string "HOdllist")
let tname_HOdllist = Typename.TN_typedef (Mangled.from_string "HOdllist")
let create_absrules_from_tdecl tenv tname =
if (not (!Config.on_the_fly)) && Sil.typename_equal tname tname_HSlist2 then
if (not (!Config.on_the_fly)) && Typename.equal tname tname_HSlist2 then
(* L.out "@[.... Adding Abstraction Rules for Nested Lists ....@\n@."; *)
let para1 = create_hpara_from_tname_flds tenv tname_list name_down [] [] Sil.inst_abstraction in
let para2 = create_hpara_from_tname_flds tenv tname_HSlist2 name_next [name_down] [] Sil.inst_abstraction in
let para_nested = create_hpara_from_tname_twoflds_hpara tenv tname_HSlist2 name_next name_down para1 Sil.inst_abstraction in
let para_nested_base = create_hpara_two_ptsto tname_HSlist2 tenv name_next name_down tname_list name_down Sil.inst_abstraction in
IList.iter abs_rules_add_sll [para_nested_base; para2; para_nested]
else if (not (!Config.on_the_fly)) && Sil.typename_equal tname tname_dllist then
else if (not (!Config.on_the_fly)) && Typename.equal tname tname_dllist then
(* L.out "@[.... Adding Abstraction Rules for Doubly-linked Lists ....@\n@."; *)
let para = create_dll_hpara_from_tname_flds tenv tname_dllist name_Flink name_Blink [] [] Sil.inst_abstraction in
abs_rules_add_dll para
else if (not (!Config.on_the_fly)) && Sil.typename_equal tname tname_HOdllist then
else if (not (!Config.on_the_fly)) && Typename.equal tname tname_HOdllist then
(* L.out "@[.... Adding Abstraction Rules for High-Order Doubly-linked Lists ....@\n@."; *)
let para1 = create_hpara_from_tname_flds tenv tname_list name_down [] [] Sil.inst_abstraction in
let para2 = create_dll_hpara_from_tname_flds tenv tname_HOdllist name_Flink name_Blink [name_down] [] Sil.inst_abstraction in

2
infer/src/backend/abs.mli
Unescape View File

@ -11,7 +11,7 @@
(** Implementation of Abstraction Functions *)
(** Create abstraction rules from the definition of a type *)
val create_absrules_from_tdecl : Sil.tenv -> Sil.typename -> unit
val create_absrules_from_tdecl : Sil.tenv -> Typename.t -> unit
(** Check whether the prop contains junk.
If it does, and [Config.allowleak] is true, remove the junk, otherwise raise a Leak exception. *)

4
infer/src/backend/objc_models.ml
Unescape View File

@ -208,8 +208,8 @@ struct
match typ with
| Sil.Tptr (styp, _ ) ->
is_core_lib lib styp
| Sil.Tvar (Sil.TN_csu (_, name) )
| Sil.Tstruct(_, _, _, (Some name), _, _, _) ->
| Sil.Tvar (Typename.TN_csu (_, name) )
| Sil.Tstruct (_, _, _, (Some name), _, _, _) ->
let core_lib_types = core_lib_to_type_list lib in
IList.mem (=) (Mangled.to_string name) core_lib_types
| _ -> false

8
infer/src/backend/prover.ml
Unescape View File

@ -1447,7 +1447,7 @@ let serializable_type = Mangled.from_string "java.io.Serializable"
let cloneable_type = Mangled.from_string "java.lang.Cloneable"
let is_interface tenv c =
match Sil.tenv_lookup tenv (Sil.TN_csu (Csu.Class, c)) with
match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class, c)) with
| Some (Sil.Tstruct (fields, sfields, Csu.Class, Some c1', supers1, methods, iann)) ->
(IList.length fields = 0) && (IList.length methods = 0)
| _ -> false
@ -1456,7 +1456,7 @@ let is_interface tenv c =
let check_subclass_tenv tenv c1 c2 =
let rec check (_, c) =
Mangled.equal c c2 || (Mangled.equal c2 object_type) ||
match Sil.tenv_lookup tenv (Sil.TN_csu (Csu.Class, c)) with
match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class, c)) with
| Some (Sil.Tstruct (_, _, Csu.Class, Some c1', supers1, _, _)) ->
IList.exists check supers1
| _ -> false in
@ -1852,7 +1852,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 *
| Config.C_CPP -> Sil.Sizeof (Sil.Tarray (Sil.Tint Sil.IChar, size), Sil.Subtype.exact)
| Config.Java ->
let object_type =
Sil.TN_csu (Csu.Class, Mangled.from_string "java.lang.String") in
Typename.TN_csu (Csu.Class, Mangled.from_string "java.lang.String") in
let typ = match Sil.tenv_lookup tenv object_type with
| Some typ -> typ
| None -> assert false in
@ -1863,7 +1863,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 *
let sexp = (* TODO: add appropriate fields *)
Sil.Estruct ([(Ident.create_fieldname (Mangled.from_string "java.lang.Class.name") 0, Sil.Eexp ((Sil.Const (Sil.Cstr s), Sil.Inone)))], Sil.inst_none) in
let class_texp =
let class_type = Sil.TN_csu (Csu.Class, Mangled.from_string "java.lang.Class") in
let class_type = Typename.TN_csu (Csu.Class, Mangled.from_string "java.lang.Class") in
let typ = match Sil.tenv_lookup tenv class_type with
| Some typ -> typ
| None -> assert false in

44
infer/src/backend/sil.ml
Unescape View File

@ -88,12 +88,6 @@ let get_sentinel_func_attribute_value attr_list =
| FA_sentinel (sentinel, null_pos) -> Some (sentinel, null_pos)
with Not_found -> None
(** Named types. *)
type typename =
| TN_typedef of Mangled.t
| TN_enum of Mangled.t
| TN_csu of Csu.t * Mangled.t
(** Kind of global variables *)
type pvar_kind =
| Local_var of Procname.t (** local variable belonging to a function *)
@ -650,7 +644,7 @@ and struct_fields = (Ident.fieldname * typ * item_annotation) list
(** types for sil (structured) expressions *)
and typ =
| Tvar of typename (** named type *)
| Tvar of Typename.t (** named type *)
| Tint of ikind (** integer type *)
| Tfloat of fkind (** float type *)
| Tvoid (** void type *)
@ -1202,20 +1196,6 @@ let fkind_compare k1 k2 = match k1, k2 with
| _, FDouble -> 1
| FLongDouble, FLongDouble -> 0
let typename_compare tn1 tn2 = match tn1, tn2 with
| TN_typedef n1, TN_typedef n2 -> Mangled.compare n1 n2
| TN_typedef _, _ -> - 1
| _, TN_typedef _ -> 1
| TN_enum n1, TN_enum n2 -> Mangled.compare n1 n2
| TN_enum _, _ -> -1
| _, TN_enum _ -> 1
| TN_csu (csu1, n1), TN_csu (csu2, n2) ->
let n = Csu.compare csu1 csu2 in
if n <> 0 then n else Mangled.compare n1 n2
let typename_equal tn1 tn2 =
typename_compare tn1 tn2 = 0
let ptr_kind_compare pk1 pk2 = match pk1, pk2 with
| Pk_pointer, Pk_pointer -> 0
| Pk_pointer, _ -> -1
@ -1277,7 +1257,7 @@ let rec const_compare (c1 : const) (c2 : const) : int =
(** Comparision for types. *)
and typ_compare t1 t2 =
if t1 == t2 then 0 else match t1, t2 with
| Tvar tn1, Tvar tn2 -> typename_compare tn1 tn2
| Tvar tn1, Tvar tn2 -> Typename.compare tn1 tn2
| Tvar _, _ -> - 1
| _, Tvar _ -> 1
| Tint ik1, Tint ik2 -> ikind_compare ik1 ik2
@ -1794,16 +1774,6 @@ let fkind_to_string = function
| FDouble -> "double"
| FLongDouble -> "long double"
let typename_to_string = function
| TN_enum name
| TN_typedef name -> Mangled.to_string name
| TN_csu (csu, name) -> Csu.name csu ^ " " ^ Mangled.to_string name
let typename_name = function
| TN_enum name
| TN_typedef name
| TN_csu (_, name) -> Mangled.to_string name
let ptr_kind_string = function
| Pk_reference -> "&"
| Pk_pointer -> "*"
@ -1953,7 +1923,7 @@ and pp_typ pe f te =
pp_base prints the variable for a declaration, or can be skip to print only the type
pp_size prints the expression for the array size *)
and pp_type_decl pe pp_base pp_size f = function
| Tvar tname -> F.fprintf f "%s %a" (typename_to_string tname) pp_base ()
| Tvar tname -> F.fprintf f "%s %a" (Typename.to_string tname) pp_base ()
| Tint ik -> F.fprintf f "%s %a" (ikind_to_string ik) pp_base ()
| Tfloat fk -> F.fprintf f "%s %a" (fkind_to_string fk) pp_base ()
| Tvoid -> F.fprintf f "void %a" pp_base ()
@ -3752,8 +3722,8 @@ let hpred_compact sh hpred =
module TypenameHash =
Hashtbl.Make(struct
type t = typename
let equal tn1 tn2 = typename_equal tn1 tn2
type t = Typename.t
let equal tn1 tn2 = Typename.equal tn1 tn2
let hash = Hashtbl.hash
end)
@ -3781,7 +3751,7 @@ let get_typ name csu_option tenv =
let csu = match csu_option with
| Some t -> t
| None -> Csu.Class in
tenv_lookup tenv (TN_csu (csu, name))
tenv_lookup tenv (Typename.TN_csu (csu, name))
(** expand a type if it is a typename by looking it up in the type environment *)
let rec expand_type tenv typ =
@ -3823,7 +3793,7 @@ let tenv_fold f tenv =
let pp_tenv f (tenv : tenv) =
TypenameHash.iter
(fun name typ ->
Format.fprintf f "@[<6>NAME: %s@." (typename_to_string name);
Format.fprintf f "@[<6>NAME: %s@." (Typename.to_string name);
Format.fprintf f "@[<6>TYPE: %a@." (pp_typ_full pe_text) typ)
tenv

30
infer/src/backend/sil.mli
Unescape View File

@ -12,12 +12,6 @@
open Utils
(** Named types. *)
type typename =
| TN_typedef of Mangled.t
| TN_enum of Mangled.t
| TN_csu of Csu.t * Mangled.t
(** {2 Programs and Types} *)
(** Type to represent one @Annotation. *)
@ -285,7 +279,7 @@ and struct_fields = (Ident.fieldname * typ * item_annotation) list
(** Types for sil (structured) expressions. *)
and typ =
| Tvar of typename (** named type *)
| Tvar of Typename.t (** named type *)
| Tint of ikind (** integer type *)
| Tfloat of fkind (** float type *)
| Tvoid (** void type *)
@ -511,13 +505,13 @@ type tenv (** Type for type environment. *)
val create_tenv : unit -> tenv
(** Check if typename is found in tenv *)
val tenv_mem : tenv -> typename -> bool
val tenv_mem : tenv -> Typename.t -> bool
(** Look up a name in the global type environment. *)
val tenv_lookup : tenv -> typename -> typ option
val tenv_lookup : tenv -> Typename.t -> typ option
(** Add a (name,typ) pair to the global type environment. *)
val tenv_add : tenv -> typename -> typ -> unit
val tenv_add : tenv -> Typename.t -> typ -> unit
(** look up the type for a mangled name in the current type environment *)
val get_typ : Mangled.t -> Csu.t option -> tenv -> typ option
@ -534,16 +528,10 @@ val load_tenv_from_file : DB.filename -> tenv option
(** Save a type environment into a file *)
val store_tenv_to_file : DB.filename -> tenv -> unit
(** convert the typename to a string *)
val typename_to_string : typename -> string
(** name of the typename without qualifier *)
val typename_name : typename -> string
(** iterate over a type environment *)
val tenv_iter : (typename -> typ -> unit) -> tenv -> unit
val tenv_iter : (Typename.t -> typ -> unit) -> tenv -> unit
val tenv_fold : (typename -> typ -> 'a -> 'a) -> tenv -> 'a -> 'a
val tenv_fold : (Typename.t -> typ -> 'a -> 'a) -> tenv -> 'a -> 'a
(** print a type environment *)
val pp_tenv : Format.formatter -> tenv -> unit
@ -636,12 +624,6 @@ val ikind_is_unsigned : ikind -> bool
(** Convert an int64 into an Int.t given the kind: the int64 is interpreted as unsigned according to the kind *)
val int_of_int64_kind : int64 -> ikind -> Int.t
(** Comparison for typenames *)
val typename_compare : typename -> typename -> int
(** Equality for typenames *)
val typename_equal : typename -> typename -> bool
(** Comparision for ptr_kind *)
val ptr_kind_compare : ptr_kind -> ptr_kind -> int

8
infer/src/backend/symExec.ml
Unescape View File

@ -605,7 +605,7 @@ let resolve_method tenv class_name proc_name =
if Procname.is_java proc_name then
Procname.java_replace_class proc_name (Mangled.to_string class_name)
else Procname.c_method_replace_class proc_name (Mangled.to_string class_name) in
let type_name = Sil.TN_csu (Csu.Class, class_name) in
let type_name = Typename.TN_csu (Csu.Class, class_name) in
match Sil.tenv_lookup tenv type_name with
| Some (Sil.Tstruct (_, _, Csu.Class, cls, super_classes, methods, iann)) ->
if method_exists right_proc_name methods then
@ -987,7 +987,7 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path
(* iOS: check that NSNumber *'s are not used in conditionals without comparing to nil *)
let lhs_normal = Prop.exp_normalize_prop _prop lhs in
let is_nsnumber = function
| Sil.Tvar (Sil.TN_csu (Csu.Class, name)) ->
| Sil.Tvar (Typename.TN_csu (Csu.Class, name)) ->
Mangled.to_string name = "NSNumber"
| _ -> false in
let lhs_is_ns_ptr () =
@ -2456,7 +2456,7 @@ module ModelBuiltins = struct
sym_exec_generated false cfg tenv pdesc [alloc_instr] symb_state
let execute_objc_NSArray_alloc_no_fail cfg pdesc tenv symb_state ret_ids loc =
let nsarray_typ = Sil.Tvar (Sil.TN_csu (Csu.Class, Mangled.from_string "NSArray")) in
let nsarray_typ = Sil.Tvar (Typename.TN_csu (Csu.Class, Mangled.from_string "NSArray")) in
let nsarray_typ = Sil.expand_type tenv nsarray_typ in
execute_objc_alloc_no_fail cfg pdesc tenv symb_state ret_ids nsarray_typ loc
@ -2483,7 +2483,7 @@ module ModelBuiltins = struct
let execute_objc_NSDictionary_alloc_no_fail cfg pdesc tenv symb_state ret_ids loc =
let nsdictionary_typ =
Sil.Tvar (Sil.TN_csu (Csu.Class, Mangled.from_string "NSDictionary")) in
Sil.Tvar (Typename.TN_csu (Csu.Class, Mangled.from_string "NSDictionary")) in
let nsdictionary_typ =
Sil.expand_type tenv nsdictionary_typ in
execute_objc_alloc_no_fail cfg pdesc tenv symb_state ret_ids nsdictionary_typ loc

6
infer/src/backend/type_prop.ml
Unescape View File

@ -100,7 +100,7 @@ struct
match typ with
| Sil.Tptr (typ , _) -> type_to_string typ
| Sil.Tstruct (_, _, Csu.Class, Some mangled, _, _, _)
| Sil.Tvar ( Sil.TN_csu (Csu.Class, (mangled))) -> Mangled.to_string mangled
| Sil.Tvar (Typename.TN_csu (Csu.Class, (mangled))) -> Mangled.to_string mangled
| _ -> Sil.typ_to_string typ
let string_typ_to_string (s, typ) =
@ -312,7 +312,7 @@ let initial_node = ref (Cfg.Node.dummy ())
let rec super tenv t =
match t with
| Sil.Tstruct (_, _, Csu.Class, Some c2, (Csu.Class, super):: rest, _, _) ->
Sil.tenv_lookup tenv (Sil.TN_csu (Csu.Class, super))
Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class, super))
| Sil.Tarray (dom_type, _) -> None
| Sil.Tptr (dom_type, p) ->
let super_dom_type = super tenv dom_type in
@ -412,7 +412,7 @@ struct
| Sil.Cfun fn -> assert false
| Sil.Cstr str ->
Sil.Tptr (
Sil.Tvar ( Sil.TN_csu (Csu.Class, (Mangled.from_string ( "java.lang.String")))),
Sil.Tvar ( Typename.TN_csu (Csu.Class, (Mangled.from_string ( "java.lang.String")))),
Sil.Pk_pointer)
| Sil.Cattribute atr -> assert false
| Sil.Cexn e -> assert false

39
infer/src/backend/typename.ml
Unescape View File

@ -0,0 +1,39 @@
(*
* Copyright (c) 2015 - present Facebook, Inc.
* All rights reserved.
*
* This source code is licensed under the BSD style license found in the
* LICENSE file in the root directory of this source tree. An additional grant
* of patent rights can be found in the PATENTS file in the same directory.
*)
(** Named types. *)
type t =
| TN_typedef of Mangled.t
| TN_enum of Mangled.t
| TN_csu of Csu.t * Mangled.t
let to_string = function
| TN_enum name
| TN_typedef name -> Mangled.to_string name
| TN_csu (csu, name) ->
Csu.name csu ^ " " ^ Mangled.to_string name
let name = function
| TN_enum name
| TN_typedef name
| TN_csu (_, name) -> Mangled.to_string name
let compare tn1 tn2 = match tn1, tn2 with
| TN_typedef n1, TN_typedef n2 -> Mangled.compare n1 n2
| TN_typedef _, _ -> - 1
| _, TN_typedef _ -> 1
| TN_enum n1, TN_enum n2 -> Mangled.compare n1 n2
| TN_enum _, _ -> -1
| _, TN_enum _ -> 1
| TN_csu (csu1, n1), TN_csu (csu2, n2) ->
let n = Csu.compare csu1 csu2 in
if n <> 0 then n else Mangled.compare n1 n2
let equal tn1 tn2 =
compare tn1 tn2 = 0

26
infer/src/backend/typename.mli
Unescape View File

@ -0,0 +1,26 @@
(*
* Copyright (c) 2015 - present Facebook, Inc.
* All rights reserved.
*
* This source code is licensed under the BSD style license found in the
* LICENSE file in the root directory of this source tree. An additional grant
* of patent rights can be found in the PATENTS file in the same directory.
*)
(** Named types. *)
type t =
| TN_typedef of Mangled.t
| TN_enum of Mangled.t
| TN_csu of Csu.t * Mangled.t
(** convert the typename to a string *)
val to_string : t -> string
(** name of the typename without qualifier *)
val name : t -> string
(** Comparison for typenames *)
val compare : t -> t -> int
(** Equality for typenames *)
val equal : t -> t -> bool

8
infer/src/checkers/patternMatch.ml
Unescape View File

@ -45,7 +45,7 @@ let type_get_direct_supertypes = function
let type_get_class_name t = match t with
| Sil.Tptr (Sil.Tstruct (_, _, _, Some cn, _, _, _), _) ->
Some cn
| Sil.Tptr (Sil.Tvar (Sil.TN_csu (Csu.Class, cn)), _) ->
| Sil.Tptr (Sil.Tvar (Typename.TN_csu (Csu.Class, cn)), _) ->
Some cn
| _ -> None
@ -127,7 +127,7 @@ let type_is_nested_in_supertype tenv t csu_option n =
let rec get_type_name = function
| Sil.Tstruct (_, _, _, Some mangled, _, _, _) -> Mangled.to_string mangled
| Sil.Tptr (t, _) -> get_type_name t
| Sil.Tvar tn -> Sil.typename_name tn
| Sil.Tvar tn -> Typename.name tn
| _ -> "_"
let get_field_type_name
@ -329,7 +329,7 @@ let proc_iter_overridden_methods f tenv proc_name =
let do_super_type tenv super_class_name =
let super_proc_name =
Procname.java_replace_class proc_name (Mangled.to_string super_class_name) in
let type_name = Sil.TN_csu (Csu.Class, super_class_name) in
let type_name = Typename.TN_csu (Csu.Class, super_class_name) in
match Sil.tenv_lookup tenv type_name with
| Some (Sil.Tstruct (_, _, _, _, _, methods, _)) ->
let is_override pname =
@ -345,7 +345,7 @@ let proc_iter_overridden_methods f tenv proc_name =
if Procname.is_java proc_name then
let type_name =
let class_name = Procname.java_get_class proc_name in
Sil.TN_csu (Csu.Class, Mangled.from_string class_name) in
Typename.TN_csu (Csu.Class, Mangled.from_string class_name) in
match Sil.tenv_lookup tenv type_name with
| Some curr_type ->
IList.iter (do_super_type tenv) (type_get_direct_supertypes curr_type)

2
infer/src/clang/cContext.ml
Unescape View File

@ -116,7 +116,7 @@ let curr_class_hash curr_class =
| ContextNoCls -> Hashtbl.hash "no class"
let create_curr_class tenv class_name =
let class_tn_name = Sil.TN_csu (Csu.Class, (Mangled.from_string class_name)) in
let class_tn_name = Typename.TN_csu (Csu.Class, (Mangled.from_string class_name)) in
match Sil.tenv_lookup tenv class_tn_name with
| Some Sil.Tstruct(intf_fields, _, _, _, superclasses, methods, annotation) ->
(let superclasses_names = IList.map (fun (_, name) -> Mangled.to_string name) superclasses in

6
infer/src/clang/cField_decl.ml
Unescape View File

@ -17,11 +17,11 @@ module L = Logging
type field_type = Ident.fieldname * Sil.typ * (Sil.annotation * bool) list
let rec get_fields_super_classes tenv super_class =
Printing.log_out " ... Getting fields of superclass '%s'\n" (Sil.typename_to_string super_class);
Printing.log_out " ... Getting fields of superclass '%s'\n" (Typename.to_string super_class);
match Sil.tenv_lookup tenv super_class with
| None -> []
| Some Sil.Tstruct (fields, _, _, _, (Csu.Class, sc):: _, _, _) ->
let sc_fields = get_fields_super_classes tenv (Sil.TN_csu (Csu.Class, sc)) in
let sc_fields = get_fields_super_classes tenv (Typename.TN_csu (Csu.Class, sc)) in
General_utils.append_no_duplicates_fields fields sc_fields
| Some Sil.Tstruct (fields, _, _, _, _, _, _) -> fields
| Some _ -> []
@ -77,7 +77,7 @@ let rec get_fields type_ptr_to_sil_type tenv curr_class decl_list =
(* to the info given in the interface. Update the tenv accordingly. *)
let add_missing_fields tenv class_name fields =
let mang_name = Mangled.from_string class_name in
let class_tn_name = Sil.TN_csu (Csu.Class, mang_name) in
let class_tn_name = Typename.TN_csu (Csu.Class, mang_name) in
match Sil.tenv_lookup tenv class_tn_name with
| Some Sil.Tstruct(intf_fields, _, _, _, superclass, methods, annotation) ->
let new_fields = General_utils.append_no_duplicates_fields fields intf_fields in

2
infer/src/clang/cFrontend_checkers.ml
Unescape View File

@ -40,7 +40,7 @@ let direct_atomic_property_access context stmt_info ivar_name =
General_utils.mk_class_field_name n,
Ast_utils.get_class_name_from_member n
| _ -> Ident.create_fieldname (Mangled.from_string "") 0, "" in
let tname = Sil.TN_csu (Csu.Class, Mangled.from_string cname) in
let tname = Typename.TN_csu (Csu.Class, Mangled.from_string cname) in
let loc = CLocation.get_sil_location_from_range stmt_info.Clang_ast_t.si_source_range true in
match Sil.tenv_lookup tenv tname with
| Some Sil.Tstruct (flds1, flds2, _, _, _, _, _) ->

16
infer/src/clang/cFrontend_utils.ml
Unescape View File

@ -43,14 +43,14 @@ struct
let print_tenv tenv =
Sil.tenv_iter (fun typname typ ->
match typname with
| Sil.TN_csu (Csu.Class, _) | Sil.TN_csu (Csu.Protocol, _) ->
| Typename.TN_csu (Csu.Class, _) | Typename.TN_csu (Csu.Protocol, _) ->
(match typ with
| Sil.Tstruct (fields, _, _, cls, super_classes, methods, iann) ->
print_endline (
(Sil.typename_to_string typname) ^ "\n"^
(Typename.to_string typname) ^ "\n"^
"---> superclass and protocols " ^ (IList.to_string (fun (csu, x) ->
let nsu = Sil.TN_csu (csu, x) in
"\t" ^ (Sil.typename_to_string nsu) ^ "\n") super_classes) ^
let nsu = Typename.TN_csu (csu, x) in
"\t" ^ (Typename.to_string nsu) ^ "\n") super_classes) ^
"---> methods " ^
(IList.to_string (fun x ->"\t" ^ (Procname.to_string x) ^ "\n") methods)
^ " " ^
@ -62,14 +62,14 @@ struct
let print_tenv_struct_unions tenv =
Sil.tenv_iter (fun typname typ ->
match typname with
| Sil.TN_csu (Csu.Struct, _) | Sil.TN_csu (Csu.Union, _) ->
| Typename.TN_csu (Csu.Struct, _) | Typename.TN_csu (Csu.Union, _) ->
(match typ with
| (Sil.Tstruct (fields, static_fields, _, cls, super_classes, methods, iann)) ->
(print_endline (
(Sil.typename_to_string typname)^"\n"^
(Typename.to_string typname)^"\n"^
"\t---> fields "^(IList.to_string (fun (fieldname, typ, _) ->
match typ with
| Sil.Tvar tname -> "tvar"^(Sil.typename_to_string tname)
| Sil.Tvar tname -> "tvar"^(Typename.to_string tname)
| Sil.Tstruct (_, _, _, _, _, _, _) | _ ->
"\t struct "^(Ident.fieldname_to_string fieldname)^" "^
(Sil.typ_to_string typ)^"\n") fields
@ -77,7 +77,7 @@ struct
)
)
| _ -> ())
| Sil.TN_typedef typname ->
| Typename.TN_typedef typname ->
print_endline ((Mangled.to_string typname)^"-->"^(Sil.typ_to_string typ))
| _ -> ()
) tenv

6
infer/src/clang/cMethod_trans.ml
Unescape View File

@ -188,13 +188,13 @@ let get_method_name_from_clang tenv ms_opt =
let get_superclass_curr_class context =
let retrive_super cname super_opt =
let iname = Sil.TN_csu (Csu.Class, Mangled.from_string cname) in
Printing.log_out "Checking for superclass = '%s'\n\n%!" (Sil.typename_to_string iname);
let iname = Typename.TN_csu (Csu.Class, Mangled.from_string cname) in
Printing.log_out "Checking for superclass = '%s'\n\n%!" (Typename.to_string iname);
match Sil.tenv_lookup (CContext.get_tenv context) iname with
| Some Sil.Tstruct(_, _, _, _, (_, super_name):: _, _, _) ->
Mangled.to_string super_name
| _ ->
Printing.log_err "NOT FOUND superclass = '%s'\n\n%!" (Sil.typename_to_string iname);
Printing.log_err "NOT FOUND superclass = '%s'\n\n%!" (Typename.to_string iname);
(match super_opt with
| Some super -> super
| _ -> assert false) in

10
infer/src/clang/cTrans.ml
Unescape View File

@ -119,7 +119,7 @@ struct
Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields;
let mblock = Mangled.from_string block_name in
let block_type = Sil.Tstruct (fields, [], Csu.Class, Some mblock, [], [], []) in
let block_name = Sil.TN_csu (Csu.Class, mblock) in
let block_name = Typename.TN_csu (Csu.Class, mblock) in
Sil.tenv_add tenv block_name block_type;
let trans_res = CTrans_utils.alloc_trans trans_state loc (Ast_expressions.dummy_stmt_info ()) block_type true in
let id_block = match trans_res.exps with
@ -1344,8 +1344,10 @@ struct
(match Sil.tenv_lookup context.CContext.tenv tn with
| Some (Sil.Tstruct _ as str) -> collect_left_hand_exprs e str tns
| Some ((Sil.Tvar typename) as tvar) ->
if (StringSet.mem (Sil.typename_to_string typename) tns) then ([[(e, typ)]])
else (collect_left_hand_exprs e tvar (StringSet.add (Sil.typename_to_string typename) tns));
if (StringSet.mem (Typename.to_string typename) tns) then
[[(e, typ)]]
else
collect_left_hand_exprs e tvar (StringSet.add (Typename.to_string typename) tns)
| _ -> [[(e, typ)]] (*This case is an error, shouldn't happen.*))
| Sil.Tstruct (struct_fields, _, _, _, _, _, _) as type_struct ->
let lh_exprs = IList.map ( fun (fieldname, fieldtype, _) ->
@ -1354,7 +1356,7 @@ struct
let lh_types = IList.map ( fun (fieldname, fieldtype, _) -> fieldtype)
struct_fields in
IList.map (fun (e, t) -> IList.flatten (collect_left_hand_exprs e t tns)) (zip lh_exprs lh_types)
| Sil.Tarray (arrtyp, Sil.Const(Sil.Cint(n))) ->
| Sil.Tarray (arrtyp, Sil.Const (Sil.Cint n)) ->
let size = Sil.Int.to_int n in
let indices = list_range 0 (size - 1) in
let index_constants = IList.map

4
infer/src/clang/cType_to_sil_type.ml
Unescape View File

@ -11,8 +11,8 @@ open CFrontend_utils
let get_builtin_objc_typename builtin_type =
match builtin_type with
| `ObjCId -> Sil.TN_csu (Csu.Struct, (Mangled.from_string CFrontend_config.objc_object))
| `ObjCClass -> Sil.TN_csu (Csu.Struct, (Mangled.from_string CFrontend_config.objc_class))
| `ObjCId -> Typename.TN_csu (Csu.Struct, (Mangled.from_string CFrontend_config.objc_object))
| `ObjCClass -> Typename.TN_csu (Csu.Struct, (Mangled.from_string CFrontend_config.objc_class))
let get_builtin_objc_type builtin_type =
let typ = Sil.Tvar (get_builtin_objc_typename builtin_type) in

2
infer/src/clang/cType_to_sil_type.mli
Unescape View File

@ -7,7 +7,7 @@
* of patent rights can be found in the PATENTS file in the same directory.
*)
val get_builtin_objc_typename : [< `ObjCClass | `ObjCId ] -> Sil.typename
val get_builtin_objc_typename : [< `ObjCClass | `ObjCId ] -> Typename.t
val get_builtin_objc_type : [< `ObjCClass | `ObjCId ] -> Sil.typ

12
infer/src/clang/cTypes.ml
Unescape View File

@ -40,9 +40,9 @@ let remove_pointer_to_typ typ =
let classname_of_type typ =
match typ with
| Sil.Tvar (Sil.TN_csu (_, name) )
| Sil.Tvar (Typename.TN_csu (_, name) )
| Sil.Tstruct(_, _, _, (Some name), _, _, _)
| Sil.Tvar (Sil.TN_typedef name) -> Mangled.to_string name
| Sil.Tvar (Typename.TN_typedef name) -> Mangled.to_string name
| Sil.Tfun _ -> CFrontend_config.objc_object
| _ ->
Printing.log_out
@ -65,16 +65,16 @@ let search_enum_type_by_name tenv name =
Sil.tenv_iter f tenv;
!found
let mk_classname n = Sil.TN_csu (Csu.Class, Mangled.from_string n)
let mk_classname n = Typename.TN_csu (Csu.Class, Mangled.from_string n)
let mk_structname n = Sil.TN_csu (Csu.Struct, Mangled.from_string n)
let mk_structname n = Typename.TN_csu (Csu.Struct, Mangled.from_string n)
let mk_enumname n = Sil.TN_enum (Mangled.from_string n)
let mk_enumname n = Typename.TN_enum (Mangled.from_string n)
let is_class typ =
match typ with
| Sil.Tptr( Sil.Tstruct(_, _, _, (Some name), _, _, _), _)
| Sil.Tptr( Sil.Tvar (Sil.TN_csu (_, name) ), _) ->
| Sil.Tptr( Sil.Tvar (Typename.TN_csu (_, name) ), _) ->
(Mangled.to_string name) = CFrontend_config.objc_class
| _ -> false

6
infer/src/clang/cTypes.mli
Unescape View File

@ -15,11 +15,11 @@ val search_enum_type_by_name : Sil.tenv -> string -> Sil.const option
val classname_of_type : Sil.typ -> string
val mk_classname : string -> Sil.typename
val mk_classname : string -> Typename.t
val mk_structname : string -> Sil.typename
val mk_structname : string -> Typename.t
val mk_enumname : string -> Sil.typename
val mk_enumname : string -> Typename.t
val get_name_from_struct: Sil.typ -> Mangled.t

16
infer/src/clang/cTypes_decl.ml
Unescape View File

@ -17,16 +17,16 @@ exception Typename_not_found
let add_predefined_objc_types tenv =
let objc_class_mangled = Mangled.from_string CFrontend_config.objc_class in
let objc_class_name = Sil.TN_csu (Csu.Class, objc_class_mangled) in
let objc_class_name = Typename.TN_csu (Csu.Class, objc_class_mangled) in
let objc_class_type_info =
Sil.Tstruct ([], [], Csu.Struct,
Some (Mangled.from_string CFrontend_config.objc_class), [], [], []) in
Sil.tenv_add tenv objc_class_name objc_class_type_info;
let class_typename = CType_to_sil_type.get_builtin_objc_typename `ObjCClass in
let class_typ = Sil.Tvar (Sil.TN_csu (Csu.Struct, objc_class_mangled)) in
let class_typ = Sil.Tvar (Typename.TN_csu (Csu.Struct, objc_class_mangled)) in
Sil.tenv_add tenv class_typename class_typ;
let typename_objc_object =
Sil.TN_csu (Csu.Struct, Mangled.from_string CFrontend_config.objc_object) in
Typename.TN_csu (Csu.Struct, Mangled.from_string CFrontend_config.objc_object) in
let id_typedef = Sil.Tvar (typename_objc_object) in
let id_typename = CType_to_sil_type.get_builtin_objc_typename `ObjCId in
Sil.tenv_add tenv id_typename id_typedef;
@ -151,7 +151,7 @@ let add_struct_to_tenv tenv typ =
| Sil.Tstruct(_, _, csu, _, _, _, _) -> csu
| _ -> assert false in
let mangled = CTypes.get_name_from_struct typ in
let typename = Sil.TN_csu(csu, mangled) in
let typename = Typename.TN_csu(csu, mangled) in
Sil.tenv_add tenv typename typ
let rec get_struct_fields tenv decl =
@ -187,7 +187,7 @@ and get_struct_cpp_class_declaration_type tenv decl =
| RecordDecl (_, _, _, type_ptr, decl_list, _, record_decl_info) ->
let csu, name = get_record_name_csu decl in
let mangled_name = Mangled.from_string name in
let sil_typename = Sil.Tvar (Sil.TN_csu (csu, mangled_name)) in
let sil_typename = Sil.Tvar (Typename.TN_csu (csu, mangled_name)) in
(* temporarily saves the type name to avoid infinite loops in recursive types *)
Ast_utils.update_sil_types_map type_ptr sil_typename;
if not record_decl_info.Clang_ast_t.rdi_is_complete_definition then
@ -236,8 +236,8 @@ let get_type_from_expr_info ei tenv =
let class_from_pointer_type tenv type_ptr =
match type_ptr_to_sil_type tenv type_ptr with
| Sil.Tptr( Sil.Tvar (Sil.TN_typedef name), _) -> Mangled.to_string name
| Sil.Tptr( Sil.Tvar (Sil.TN_csu (_, name)), _) -> Mangled.to_string name
| Sil.Tptr( Sil.Tvar (Typename.TN_typedef name), _) -> Mangled.to_string name
| Sil.Tptr( Sil.Tvar (Typename.TN_csu (_, name)), _) -> Mangled.to_string name
| _ -> assert false
let get_class_type_np tenv expr_info obj_c_message_expr_info =
@ -249,5 +249,5 @@ let get_class_type_np tenv expr_info obj_c_message_expr_info =
let get_type_curr_class tenv curr_class_opt =
let name = CContext.get_curr_class_name curr_class_opt in
let typ = Sil.Tvar (Sil.TN_csu (Csu.Class, (Mangled.from_string name))) in
let typ = Sil.Tvar (Typename.TN_csu (Csu.Class, (Mangled.from_string name))) in
CTypes.expand_structured_type tenv typ

2
infer/src/clang/objcCategory_decl.ml
Unescape View File

@ -73,7 +73,7 @@ let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list =
let methods = ObjcProperty_decl.get_methods curr_class decl_list in
let class_name = CContext.get_curr_class_name curr_class in
let mang_name = Mangled.from_string class_name in
let class_tn_name = Sil.TN_csu (Csu.Class, mang_name) in
let class_tn_name = Typename.TN_csu (Csu.Class, mang_name) in
let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in
Ast_utils.update_sil_types_map decl_key (Sil.Tvar class_tn_name);
(match Sil.tenv_lookup tenv class_tn_name with

8
infer/src/clang/objcInterface_decl.ml
Unescape View File

@ -31,8 +31,8 @@ let is_objc_class_annotation a =
let is_pointer_to_objc_class tenv typ =
match typ with
| Sil.Tptr (Sil.Tvar (Sil.TN_csu (Csu.Class, cname)), _) ->
(match Sil.tenv_lookup tenv (Sil.TN_csu (Csu.Class, cname)) with
| Sil.Tptr (Sil.Tvar (Typename.TN_csu (Csu.Class, cname)), _) ->
(match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class, cname)) with
| Some Sil.Tstruct(_, _, Csu.Class, _, _, _, a) when is_objc_class_annotation a -> true
| _ -> false)
| Sil.Tptr (Sil.Tstruct(_, _, Csu.Class, _, _, _, a), _) when
@ -142,7 +142,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name
superclasses, methods, objc_class_annotation) in
Sil.tenv_add tenv interface_name interface_type_info;
Printing.log_out
" >>>Verifying that Typename '%s' is in tenv\n" (Sil.typename_to_string interface_name);
" >>>Verifying that Typename '%s' is in tenv\n" (Typename.to_string interface_name);
(match Sil.tenv_lookup tenv interface_name with
| Some t -> Printing.log_out " >>>OK. Found typ='%s'\n" (Sil.typ_to_string t)
| None -> Printing.log_out " >>>NOT Found!!\n");
@ -150,7 +150,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name
let add_missing_methods tenv class_name decl_info decl_list curr_class =
let methods = ObjcProperty_decl.get_methods curr_class decl_list in
let class_tn_name = Sil.TN_csu (Csu.Class, (Mangled.from_string class_name)) in
let class_tn_name = Typename.TN_csu (Csu.Class, (Mangled.from_string class_name)) in
let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in
Ast_utils.update_sil_types_map decl_key (Sil.Tvar class_tn_name);
(match Sil.tenv_lookup tenv class_tn_name with

2
infer/src/clang/objcProtocol_decl.ml
Unescape View File

@ -28,7 +28,7 @@ let protocol_decl type_ptr_to_sil_type tenv decl =
(* It may turn out that we need a more specific treatment for protocols*)
Printing.log_out "ADDING: ObjCProtocolDecl for '%s'\n" name;
let mang_name = Mangled.from_string name in
let protocol_name = Sil.TN_csu (Csu.Protocol, mang_name) in
let protocol_name = Typename.TN_csu (Csu.Protocol, mang_name) in
let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in
Ast_utils.update_sil_types_map decl_key (Sil.Tvar protocol_name);
let methods = ObjcProperty_decl.get_methods curr_class decl_list in

4
infer/src/harness/androidFramework.ml
Unescape View File

@ -377,8 +377,8 @@ let is_runtime_exception tenv exn =
let lookup = Sil.tenv_lookup tenv in
let runtime_exception_typename =
let name = Mangled.from_package_class "java.lang" "RuntimeException" in
Sil.TN_csu (Csu.Class, name)
and exn_typename = Sil.TN_csu (Csu.Class, exn) in
Typename.TN_csu (Csu.Class, name)
and exn_typename = Typename.TN_csu (Csu.Class, exn) in
match lookup runtime_exception_typename, lookup exn_typename with
| Some runtime_exception_type, Some exn_type ->
is_subtype exn_type runtime_exception_type tenv

2
infer/src/harness/harness.ml
Unescape View File

@ -143,7 +143,7 @@ let extract_callbacks lifecycle_trace harness_procname proc_file_map tenv =
Sil.Tstruct (fields, [], Csu.Class, Some harness_name, [], [harness_procname], []) in
(* update the tenv with our created harness typ. we don't have to save the tenv to disk here
* because this is done immediately after harness generation runs in jMain.ml *)
let harness_class = Sil.TN_csu (Csu.Class, harness_name) in
let harness_class = Typename.TN_csu (Csu.Class, harness_name) in
Sil.tenv_add tenv harness_class harness_typ;
let cfgs_to_save =
IList.fold_left (fun cfgs_to_save (_, _, instrument_sil_f) ->

2
infer/src/harness/stacktrace.ml
Unescape View File

@ -42,7 +42,7 @@ let try_resolve_frame str_frame exe_env tenv =
(* find the class name in the tenv and get the procedure(s) whose names match the procedure name
* in the stack trace. Note that the stack trace does not have any type or argument information;
* the name is all that we have to go on *)
match Sil.tenv_lookup tenv (Sil.TN_csu (Csu.Class, class_name)) with
match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class, class_name)) with
| Some Sil.Tstruct (_, _, Csu.Class, _, _, decl_procs, _) ->
let possible_calls =
IList.filter

2
infer/src/java/jTransType.ml
Unescape View File

@ -59,7 +59,7 @@ let const_type const =
let typename_of_classname cn =
Sil.TN_csu (Csu.Class, (Mangled.from_string (JBasics.cn_name cn)))
Typename.TN_csu (Csu.Class, (Mangled.from_string (JBasics.cn_name cn)))
let rec get_named_type vt =

2
infer/src/java/jTransType.mli
Unescape View File

@ -15,7 +15,7 @@ open Sawja_pack
val get_named_type : JBasics.value_type -> Sil.typ
(** transforms a Java class name into a Sil class name *)
val typename_of_classname : JBasics.class_name -> Sil.typename
val typename_of_classname : JBasics.class_name -> Typename.t
(** returns a name for a field based on a class name and a field name *)
val create_fieldname : JBasics.class_name -> JBasics.field_signature -> Ident.fieldname

Write Preview
Loading…
Cancel
Save