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', _) -> | Sil.Tptr (Sil.Tvar tname', _) ->
let typ' = match Sil.tenv_lookup tenv tname' with let typ' = match Sil.tenv_lookup tenv tname' with
| None -> | 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 t
| Some typ' -> typ' in | Some typ' -> typ' in
Sil.exp_equal te (Sil.Sizeof (typ', Sil.Subtype.exact)) 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 _ -> | Sil.Tvar _ | Sil.Tint _ | Sil.Tfloat _ | Sil.Tvoid | Sil.Tfun _ | Sil.Tenum _ ->
false false
| Sil.Tptr (Sil.Tvar tname', _) -> | Sil.Tptr (Sil.Tvar tname', _) ->
Sil.typename_equal tname tname' Typename.equal tname tname'
| Sil.Tptr _ | Sil.Tstruct _ | Sil.Tarray _ -> | Sil.Tptr _ | Sil.Tstruct _ | Sil.Tarray _ ->
false in false in
match typ with 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 let body = [ptsto; lseg] in
Prop.mk_dll_hpara id_cell id_blink id_flink [] [id_down] body 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 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 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_Flink = Ident.create_fieldname (Mangled.from_string "Flink") 0
let name_Blink = Ident.create_fieldname (Mangled.from_string "Blink") 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 = 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@."; *) (* 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 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 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 = 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 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] 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@."; *) (* 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 let para = create_dll_hpara_from_tname_flds tenv tname_dllist name_Flink name_Blink [] [] Sil.inst_abstraction in
abs_rules_add_dll para 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@."; *) (* 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 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 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 *) (** Implementation of Abstraction Functions *)
(** Create abstraction rules from the definition of a type *) (** 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. (** Check whether the prop contains junk.
If it does, and [Config.allowleak] is true, remove the junk, otherwise raise a Leak exception. *) 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 match typ with
| Sil.Tptr (styp, _ ) -> | Sil.Tptr (styp, _ ) ->
is_core_lib lib styp is_core_lib lib styp
| Sil.Tvar (Sil.TN_csu (_, name) ) | Sil.Tvar (Typename.TN_csu (_, name) )
| Sil.Tstruct(_, _, _, (Some name), _, _, _) -> | Sil.Tstruct (_, _, _, (Some name), _, _, _) ->
let core_lib_types = core_lib_to_type_list lib in let core_lib_types = core_lib_to_type_list lib in
IList.mem (=) (Mangled.to_string name) core_lib_types IList.mem (=) (Mangled.to_string name) core_lib_types
| _ -> false | _ -> 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 cloneable_type = Mangled.from_string "java.lang.Cloneable"
let is_interface tenv c = 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)) -> | Some (Sil.Tstruct (fields, sfields, Csu.Class, Some c1', supers1, methods, iann)) ->
(IList.length fields = 0) && (IList.length methods = 0) (IList.length fields = 0) && (IList.length methods = 0)
| _ -> false | _ -> false
@ -1456,7 +1456,7 @@ let is_interface tenv c =
let check_subclass_tenv tenv c1 c2 = let check_subclass_tenv tenv c1 c2 =
let rec check (_, c) = let rec check (_, c) =
Mangled.equal c c2 || (Mangled.equal c2 object_type) || 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, _, _)) -> | Some (Sil.Tstruct (_, _, Csu.Class, Some c1', supers1, _, _)) ->
IList.exists check supers1 IList.exists check supers1
| _ -> false in | _ -> 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.C_CPP -> Sil.Sizeof (Sil.Tarray (Sil.Tint Sil.IChar, size), Sil.Subtype.exact)
| Config.Java -> | Config.Java ->
let object_type = 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 let typ = match Sil.tenv_lookup tenv object_type with
| Some typ -> typ | Some typ -> typ
| None -> assert false in | 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 *) 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 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_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 let typ = match Sil.tenv_lookup tenv class_type with
| Some typ -> typ | Some typ -> typ
| None -> assert false in | 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) | FA_sentinel (sentinel, null_pos) -> Some (sentinel, null_pos)
with Not_found -> None 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 *) (** Kind of global variables *)
type pvar_kind = type pvar_kind =
| Local_var of Procname.t (** local variable belonging to a function *) | 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 *) (** types for sil (structured) expressions *)
and typ = and typ =
| Tvar of typename (** named type *) | Tvar of Typename.t (** named type *)
| Tint of ikind (** integer type *) | Tint of ikind (** integer type *)
| Tfloat of fkind (** float type *) | Tfloat of fkind (** float type *)
| Tvoid (** void type *) | Tvoid (** void type *)
@ -1202,20 +1196,6 @@ let fkind_compare k1 k2 = match k1, k2 with
| _, FDouble -> 1 | _, FDouble -> 1
| FLongDouble, FLongDouble -> 0 | 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 let ptr_kind_compare pk1 pk2 = match pk1, pk2 with
| Pk_pointer, Pk_pointer -> 0 | Pk_pointer, Pk_pointer -> 0
| Pk_pointer, _ -> -1 | Pk_pointer, _ -> -1
@ -1277,7 +1257,7 @@ let rec const_compare (c1 : const) (c2 : const) : int =
(** Comparision for types. *) (** Comparision for types. *)
and typ_compare t1 t2 = and typ_compare t1 t2 =
if t1 == t2 then 0 else match t1, t2 with 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
| _, Tvar _ -> 1 | _, Tvar _ -> 1
| Tint ik1, Tint ik2 -> ikind_compare ik1 ik2 | Tint ik1, Tint ik2 -> ikind_compare ik1 ik2
@ -1794,16 +1774,6 @@ let fkind_to_string = function
| FDouble -> "double" | FDouble -> "double"
| FLongDouble -> "long 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 let ptr_kind_string = function
| Pk_reference -> "&" | Pk_reference -> "&"
| Pk_pointer -> "*" | 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_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 *) pp_size prints the expression for the array size *)
and pp_type_decl pe pp_base pp_size f = function 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 () | 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 () | Tfloat fk -> F.fprintf f "%s %a" (fkind_to_string fk) pp_base ()
| Tvoid -> F.fprintf f "void %a" pp_base () | Tvoid -> F.fprintf f "void %a" pp_base ()
@ -3752,8 +3722,8 @@ let hpred_compact sh hpred =
module TypenameHash = module TypenameHash =
Hashtbl.Make(struct Hashtbl.Make(struct
type t = typename type t = Typename.t
let equal tn1 tn2 = typename_equal tn1 tn2 let equal tn1 tn2 = Typename.equal tn1 tn2
let hash = Hashtbl.hash let hash = Hashtbl.hash
end) end)
@ -3781,7 +3751,7 @@ let get_typ name csu_option tenv =
let csu = match csu_option with let csu = match csu_option with
| Some t -> t | Some t -> t
| None -> Csu.Class in | 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 *) (** expand a type if it is a typename by looking it up in the type environment *)
let rec expand_type tenv typ = let rec expand_type tenv typ =
@ -3823,7 +3793,7 @@ let tenv_fold f tenv =
let pp_tenv f (tenv : tenv) = let pp_tenv f (tenv : tenv) =
TypenameHash.iter TypenameHash.iter
(fun name typ -> (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) Format.fprintf f "@[<6>TYPE: %a@." (pp_typ_full pe_text) typ)
tenv tenv

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

@ -12,12 +12,6 @@
open Utils 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} *) (** {2 Programs and Types} *)
(** Type to represent one @Annotation. *) (** Type to represent one @Annotation. *)
@ -285,7 +279,7 @@ and struct_fields = (Ident.fieldname * typ * item_annotation) list
(** Types for sil (structured) expressions. *) (** Types for sil (structured) expressions. *)
and typ = and typ =
| Tvar of typename (** named type *) | Tvar of Typename.t (** named type *)
| Tint of ikind (** integer type *) | Tint of ikind (** integer type *)
| Tfloat of fkind (** float type *) | Tfloat of fkind (** float type *)
| Tvoid (** void type *) | Tvoid (** void type *)
@ -511,13 +505,13 @@ type tenv (** Type for type environment. *)
val create_tenv : unit -> tenv val create_tenv : unit -> tenv
(** Check if typename is found in 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. *) (** 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. *) (** 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 *) (** look up the type for a mangled name in the current type environment *)
val get_typ : Mangled.t -> Csu.t option -> tenv -> typ option 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 *) (** Save a type environment into a file *)
val store_tenv_to_file : DB.filename -> tenv -> unit 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 *) (** 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 *) (** print a type environment *)
val pp_tenv : Format.formatter -> tenv -> unit 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 *) (** 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 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 *) (** Comparision for ptr_kind *)
val ptr_kind_compare : ptr_kind -> ptr_kind -> int 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 if Procname.is_java proc_name then
Procname.java_replace_class proc_name (Mangled.to_string class_name) 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 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 match Sil.tenv_lookup tenv type_name with
| Some (Sil.Tstruct (_, _, Csu.Class, cls, super_classes, methods, iann)) -> | Some (Sil.Tstruct (_, _, Csu.Class, cls, super_classes, methods, iann)) ->
if method_exists right_proc_name methods then 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 *) (* 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 lhs_normal = Prop.exp_normalize_prop _prop lhs in
let is_nsnumber = function 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" Mangled.to_string name = "NSNumber"
| _ -> false in | _ -> false in
let lhs_is_ns_ptr () = let lhs_is_ns_ptr () =
@ -2456,7 +2456,7 @@ module ModelBuiltins = struct
sym_exec_generated false cfg tenv pdesc [alloc_instr] symb_state 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 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 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 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 execute_objc_NSDictionary_alloc_no_fail cfg pdesc tenv symb_state ret_ids loc =
let nsdictionary_typ = 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 = let nsdictionary_typ =
Sil.expand_type tenv nsdictionary_typ in Sil.expand_type tenv nsdictionary_typ in
execute_objc_alloc_no_fail cfg pdesc tenv symb_state ret_ids nsdictionary_typ loc 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 match typ with
| Sil.Tptr (typ , _) -> type_to_string typ | Sil.Tptr (typ , _) -> type_to_string typ
| Sil.Tstruct (_, _, Csu.Class, Some mangled, _, _, _) | 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 | _ -> Sil.typ_to_string typ
let string_typ_to_string (s, typ) = let string_typ_to_string (s, typ) =
@ -312,7 +312,7 @@ let initial_node = ref (Cfg.Node.dummy ())
let rec super tenv t = let rec super tenv t =
match t with match t with
| Sil.Tstruct (_, _, Csu.Class, Some c2, (Csu.Class, super):: rest, _, _) -> | 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.Tarray (dom_type, _) -> None
| Sil.Tptr (dom_type, p) -> | Sil.Tptr (dom_type, p) ->
let super_dom_type = super tenv dom_type in let super_dom_type = super tenv dom_type in
@ -412,7 +412,7 @@ struct
| Sil.Cfun fn -> assert false | Sil.Cfun fn -> assert false
| Sil.Cstr str -> | Sil.Cstr str ->
Sil.Tptr ( 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.Pk_pointer)
| Sil.Cattribute atr -> assert false | Sil.Cattribute atr -> assert false
| Sil.Cexn e -> 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 let type_get_class_name t = match t with
| Sil.Tptr (Sil.Tstruct (_, _, _, Some cn, _, _, _), _) -> | Sil.Tptr (Sil.Tstruct (_, _, _, Some cn, _, _, _), _) ->
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 Some cn
| _ -> None | _ -> None
@ -127,7 +127,7 @@ let type_is_nested_in_supertype tenv t csu_option n =
let rec get_type_name = function let rec get_type_name = function
| Sil.Tstruct (_, _, _, Some mangled, _, _, _) -> Mangled.to_string mangled | Sil.Tstruct (_, _, _, Some mangled, _, _, _) -> Mangled.to_string mangled
| Sil.Tptr (t, _) -> get_type_name t | 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 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 do_super_type tenv super_class_name =
let super_proc_name = let super_proc_name =
Procname.java_replace_class proc_name (Mangled.to_string super_class_name) in 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 match Sil.tenv_lookup tenv type_name with
| Some (Sil.Tstruct (_, _, _, _, _, methods, _)) -> | Some (Sil.Tstruct (_, _, _, _, _, methods, _)) ->
let is_override pname = let is_override pname =
@ -345,7 +345,7 @@ let proc_iter_overridden_methods f tenv proc_name =
if Procname.is_java proc_name then if Procname.is_java proc_name then
let type_name = let type_name =
let class_name = Procname.java_get_class proc_name in 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 match Sil.tenv_lookup tenv type_name with
| Some curr_type -> | Some curr_type ->
IList.iter (do_super_type tenv) (type_get_direct_supertypes 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" | ContextNoCls -> Hashtbl.hash "no class"
let create_curr_class tenv class_name = 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 match Sil.tenv_lookup tenv class_tn_name with
| Some Sil.Tstruct(intf_fields, _, _, _, superclasses, methods, annotation) -> | Some Sil.Tstruct(intf_fields, _, _, _, superclasses, methods, annotation) ->
(let superclasses_names = IList.map (fun (_, name) -> Mangled.to_string name) superclasses in (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 type field_type = Ident.fieldname * Sil.typ * (Sil.annotation * bool) list
let rec get_fields_super_classes tenv super_class = 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 match Sil.tenv_lookup tenv super_class with
| None -> [] | None -> []
| Some Sil.Tstruct (fields, _, _, _, (Csu.Class, sc):: _, _, _) -> | 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 General_utils.append_no_duplicates_fields fields sc_fields
| Some Sil.Tstruct (fields, _, _, _, _, _, _) -> fields | Some Sil.Tstruct (fields, _, _, _, _, _, _) -> fields
| Some _ -> [] | 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. *) (* to the info given in the interface. Update the tenv accordingly. *)
let add_missing_fields tenv class_name fields = let add_missing_fields tenv class_name fields =
let mang_name = Mangled.from_string class_name 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
match Sil.tenv_lookup tenv class_tn_name with match Sil.tenv_lookup tenv class_tn_name with
| Some Sil.Tstruct(intf_fields, _, _, _, superclass, methods, annotation) -> | Some Sil.Tstruct(intf_fields, _, _, _, superclass, methods, annotation) ->
let new_fields = General_utils.append_no_duplicates_fields fields intf_fields in 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, General_utils.mk_class_field_name n,
Ast_utils.get_class_name_from_member n Ast_utils.get_class_name_from_member n
| _ -> Ident.create_fieldname (Mangled.from_string "") 0, "" in | _ -> 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 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 match Sil.tenv_lookup tenv tname with
| Some Sil.Tstruct (flds1, flds2, _, _, _, _, _) -> | Some Sil.Tstruct (flds1, flds2, _, _, _, _, _) ->

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

@ -43,14 +43,14 @@ struct
let print_tenv tenv = let print_tenv tenv =
Sil.tenv_iter (fun typname typ -> Sil.tenv_iter (fun typname typ ->
match typname with 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 (match typ with
| Sil.Tstruct (fields, _, _, cls, super_classes, methods, iann) -> | Sil.Tstruct (fields, _, _, cls, super_classes, methods, iann) ->
print_endline ( print_endline (
(Sil.typename_to_string typname) ^ "\n"^ (Typename.to_string typname) ^ "\n"^
"---> superclass and protocols " ^ (IList.to_string (fun (csu, x) -> "---> superclass and protocols " ^ (IList.to_string (fun (csu, x) ->
let nsu = Sil.TN_csu (csu, x) in let nsu = Typename.TN_csu (csu, x) in
"\t" ^ (Sil.typename_to_string nsu) ^ "\n") super_classes) ^ "\t" ^ (Typename.to_string nsu) ^ "\n") super_classes) ^
"---> methods " ^ "---> methods " ^
(IList.to_string (fun x ->"\t" ^ (Procname.to_string x) ^ "\n") methods) (IList.to_string (fun x ->"\t" ^ (Procname.to_string x) ^ "\n") methods)
^ " " ^ ^ " " ^
@ -62,14 +62,14 @@ struct
let print_tenv_struct_unions tenv = let print_tenv_struct_unions tenv =
Sil.tenv_iter (fun typname typ -> Sil.tenv_iter (fun typname typ ->
match typname with 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 (match typ with
| (Sil.Tstruct (fields, static_fields, _, cls, super_classes, methods, iann)) -> | (Sil.Tstruct (fields, static_fields, _, cls, super_classes, methods, iann)) ->
(print_endline ( (print_endline (
(Sil.typename_to_string typname)^"\n"^ (Typename.to_string typname)^"\n"^
"\t---> fields "^(IList.to_string (fun (fieldname, typ, _) -> "\t---> fields "^(IList.to_string (fun (fieldname, typ, _) ->
match typ with match typ with
| Sil.Tvar tname -> "tvar"^(Sil.typename_to_string tname) | Sil.Tvar tname -> "tvar"^(Typename.to_string tname)
| Sil.Tstruct (_, _, _, _, _, _, _) | _ -> | Sil.Tstruct (_, _, _, _, _, _, _) | _ ->
"\t struct "^(Ident.fieldname_to_string fieldname)^" "^ "\t struct "^(Ident.fieldname_to_string fieldname)^" "^
(Sil.typ_to_string typ)^"\n") fields (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)) print_endline ((Mangled.to_string typname)^"-->"^(Sil.typ_to_string typ))
| _ -> () | _ -> ()
) tenv ) 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 get_superclass_curr_class context =
let retrive_super cname super_opt = let retrive_super cname super_opt =
let iname = Sil.TN_csu (Csu.Class, Mangled.from_string cname) in let iname = Typename.TN_csu (Csu.Class, Mangled.from_string cname) in
Printing.log_out "Checking for superclass = '%s'\n\n%!" (Sil.typename_to_string iname); Printing.log_out "Checking for superclass = '%s'\n\n%!" (Typename.to_string iname);
match Sil.tenv_lookup (CContext.get_tenv context) iname with match Sil.tenv_lookup (CContext.get_tenv context) iname with
| Some Sil.Tstruct(_, _, _, _, (_, super_name):: _, _, _) -> | Some Sil.Tstruct(_, _, _, _, (_, super_name):: _, _, _) ->
Mangled.to_string 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 (match super_opt with
| Some super -> super | Some super -> super
| _ -> assert false) in | _ -> 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; Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields;
let mblock = Mangled.from_string block_name in let mblock = Mangled.from_string block_name in
let block_type = Sil.Tstruct (fields, [], Csu.Class, Some mblock, [], [], []) 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; 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 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 let id_block = match trans_res.exps with
@ -1344,8 +1344,10 @@ struct
(match Sil.tenv_lookup context.CContext.tenv tn with (match Sil.tenv_lookup context.CContext.tenv tn with
| Some (Sil.Tstruct _ as str) -> collect_left_hand_exprs e str tns | Some (Sil.Tstruct _ as str) -> collect_left_hand_exprs e str tns
| Some ((Sil.Tvar typename) as tvar) -> | Some ((Sil.Tvar typename) as tvar) ->
if (StringSet.mem (Sil.typename_to_string typename) tns) then ([[(e, typ)]]) if (StringSet.mem (Typename.to_string typename) tns) then
else (collect_left_hand_exprs e tvar (StringSet.add (Sil.typename_to_string typename) tns)); [[(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.*)) | _ -> [[(e, typ)]] (*This case is an error, shouldn't happen.*))
| Sil.Tstruct (struct_fields, _, _, _, _, _, _) as type_struct -> | Sil.Tstruct (struct_fields, _, _, _, _, _, _) as type_struct ->
let lh_exprs = IList.map ( fun (fieldname, fieldtype, _) -> let lh_exprs = IList.map ( fun (fieldname, fieldtype, _) ->
@ -1354,7 +1356,7 @@ struct
let lh_types = IList.map ( fun (fieldname, fieldtype, _) -> fieldtype) let lh_types = IList.map ( fun (fieldname, fieldtype, _) -> fieldtype)
struct_fields in struct_fields in
IList.map (fun (e, t) -> IList.flatten (collect_left_hand_exprs e t tns)) (zip lh_exprs lh_types) 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 size = Sil.Int.to_int n in
let indices = list_range 0 (size - 1) in let indices = list_range 0 (size - 1) in
let index_constants = IList.map 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 = let get_builtin_objc_typename builtin_type =
match builtin_type with match builtin_type with
| `ObjCId -> Sil.TN_csu (Csu.Struct, (Mangled.from_string CFrontend_config.objc_object)) | `ObjCId -> Typename.TN_csu (Csu.Struct, (Mangled.from_string CFrontend_config.objc_object))
| `ObjCClass -> Sil.TN_csu (Csu.Struct, (Mangled.from_string CFrontend_config.objc_class)) | `ObjCClass -> Typename.TN_csu (Csu.Struct, (Mangled.from_string CFrontend_config.objc_class))
let get_builtin_objc_type builtin_type = let get_builtin_objc_type builtin_type =
let typ = Sil.Tvar (get_builtin_objc_typename builtin_type) in 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. * 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 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 = let classname_of_type typ =
match typ with match typ with
| Sil.Tvar (Sil.TN_csu (_, name) ) | Sil.Tvar (Typename.TN_csu (_, name) )
| Sil.Tstruct(_, _, _, (Some 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 | Sil.Tfun _ -> CFrontend_config.objc_object
| _ -> | _ ->
Printing.log_out Printing.log_out
@ -65,16 +65,16 @@ let search_enum_type_by_name tenv name =
Sil.tenv_iter f tenv; Sil.tenv_iter f tenv;
!found !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 = let is_class typ =
match typ with match typ with
| Sil.Tptr( Sil.Tstruct(_, _, _, (Some name), _, _, _), _) | 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 (Mangled.to_string name) = CFrontend_config.objc_class
| _ -> false | _ -> 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 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 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 add_predefined_objc_types tenv =
let objc_class_mangled = Mangled.from_string CFrontend_config.objc_class in 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 = let objc_class_type_info =
Sil.Tstruct ([], [], Csu.Struct, Sil.Tstruct ([], [], Csu.Struct,
Some (Mangled.from_string CFrontend_config.objc_class), [], [], []) in Some (Mangled.from_string CFrontend_config.objc_class), [], [], []) in
Sil.tenv_add tenv objc_class_name objc_class_type_info; 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_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; Sil.tenv_add tenv class_typename class_typ;
let typename_objc_object = 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_typedef = Sil.Tvar (typename_objc_object) in
let id_typename = CType_to_sil_type.get_builtin_objc_typename `ObjCId in let id_typename = CType_to_sil_type.get_builtin_objc_typename `ObjCId in
Sil.tenv_add tenv id_typename id_typedef; Sil.tenv_add tenv id_typename id_typedef;
@ -151,7 +151,7 @@ let add_struct_to_tenv tenv typ =
| Sil.Tstruct(_, _, csu, _, _, _, _) -> csu | Sil.Tstruct(_, _, csu, _, _, _, _) -> csu
| _ -> assert false in | _ -> assert false in
let mangled = CTypes.get_name_from_struct typ 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 Sil.tenv_add tenv typename typ
let rec get_struct_fields tenv decl = 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) -> | RecordDecl (_, _, _, type_ptr, decl_list, _, record_decl_info) ->
let csu, name = get_record_name_csu decl in let csu, name = get_record_name_csu decl in
let mangled_name = Mangled.from_string name 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 *) (* temporarily saves the type name to avoid infinite loops in recursive types *)
Ast_utils.update_sil_types_map type_ptr sil_typename; Ast_utils.update_sil_types_map type_ptr sil_typename;
if not record_decl_info.Clang_ast_t.rdi_is_complete_definition then 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 = let class_from_pointer_type tenv type_ptr =
match type_ptr_to_sil_type tenv type_ptr with 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 (Typename.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_csu (_, name)), _) -> Mangled.to_string name
| _ -> assert false | _ -> assert false
let get_class_type_np tenv expr_info obj_c_message_expr_info = 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 get_type_curr_class tenv curr_class_opt =
let name = CContext.get_curr_class_name curr_class_opt in 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 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 methods = ObjcProperty_decl.get_methods curr_class decl_list in
let class_name = CContext.get_curr_class_name curr_class in let class_name = CContext.get_curr_class_name curr_class in
let mang_name = Mangled.from_string class_name 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 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); Ast_utils.update_sil_types_map decl_key (Sil.Tvar class_tn_name);
(match Sil.tenv_lookup tenv class_tn_name with (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 = let is_pointer_to_objc_class tenv typ =
match typ with match typ with
| Sil.Tptr (Sil.Tvar (Sil.TN_csu (Csu.Class, cname)), _) -> | Sil.Tptr (Sil.Tvar (Typename.TN_csu (Csu.Class, cname)), _) ->
(match Sil.tenv_lookup tenv (Sil.TN_csu (Csu.Class, cname)) with (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 | Some Sil.Tstruct(_, _, Csu.Class, _, _, _, a) when is_objc_class_annotation a -> true
| _ -> false) | _ -> false)
| Sil.Tptr (Sil.Tstruct(_, _, Csu.Class, _, _, _, a), _) when | 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 superclasses, methods, objc_class_annotation) in
Sil.tenv_add tenv interface_name interface_type_info; Sil.tenv_add tenv interface_name interface_type_info;
Printing.log_out 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 (match Sil.tenv_lookup tenv interface_name with
| Some t -> Printing.log_out " >>>OK. Found typ='%s'\n" (Sil.typ_to_string t) | Some t -> Printing.log_out " >>>OK. Found typ='%s'\n" (Sil.typ_to_string t)
| None -> Printing.log_out " >>>NOT Found!!\n"); | 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 add_missing_methods tenv class_name decl_info decl_list curr_class =
let methods = ObjcProperty_decl.get_methods curr_class decl_list in 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 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); Ast_utils.update_sil_types_map decl_key (Sil.Tvar class_tn_name);
(match Sil.tenv_lookup tenv class_tn_name with (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*) (* It may turn out that we need a more specific treatment for protocols*)
Printing.log_out "ADDING: ObjCProtocolDecl for '%s'\n" name; Printing.log_out "ADDING: ObjCProtocolDecl for '%s'\n" name;
let mang_name = Mangled.from_string name in 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 let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in
Ast_utils.update_sil_types_map decl_key (Sil.Tvar protocol_name); Ast_utils.update_sil_types_map decl_key (Sil.Tvar protocol_name);
let methods = ObjcProperty_decl.get_methods curr_class decl_list in 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 lookup = Sil.tenv_lookup tenv in
let runtime_exception_typename = let runtime_exception_typename =
let name = Mangled.from_package_class "java.lang" "RuntimeException" in let name = Mangled.from_package_class "java.lang" "RuntimeException" in
Sil.TN_csu (Csu.Class, name) Typename.TN_csu (Csu.Class, name)
and exn_typename = Sil.TN_csu (Csu.Class, exn) in and exn_typename = Typename.TN_csu (Csu.Class, exn) in
match lookup runtime_exception_typename, lookup exn_typename with match lookup runtime_exception_typename, lookup exn_typename with
| Some runtime_exception_type, Some exn_type -> | Some runtime_exception_type, Some exn_type ->
is_subtype exn_type runtime_exception_type tenv 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 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 (* 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 *) * 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; Sil.tenv_add tenv harness_class harness_typ;
let cfgs_to_save = let cfgs_to_save =
IList.fold_left (fun cfgs_to_save (_, _, instrument_sil_f) -> 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 (* 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; * 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 *) * 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, _) -> | Some Sil.Tstruct (_, _, Csu.Class, _, _, decl_procs, _) ->
let possible_calls = let possible_calls =
IList.filter IList.filter

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

@ -59,7 +59,7 @@ let const_type const =
let typename_of_classname cn = 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 = 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 val get_named_type : JBasics.value_type -> Sil.typ
(** transforms a Java class name into a Sil class name *) (** 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 *) (** 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 val create_fieldname : JBasics.class_name -> JBasics.field_signature -> Ident.fieldname

Write Preview
Loading…
Cancel
Save