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

Distinguish between class kinds: CPP, Java, Objc

Browse Source 
Reviewed By: dulmarod

Differential Revision: D2866278

fb-gh-sync-id: 7b3cc33
master
Cristiano Calcagno 9 years ago committed by facebook-github-bot-7
parent bdab22a093
commit 7673d94600
37 changed files with 172 additions and 140 deletions
Show Stats Download Patch File Download Diff File

23
infer/src/backend/csu.ml
Unescape View File

@ -13,23 +13,36 @@ open Utils
C-style structs struct and union, C-style structs struct and union,
And Objective C protocol *) And Objective C protocol *)
type class_kind =
| CPP
| Java
| Objc
type t = type t =
| Class | Class of class_kind
| Struct | Struct
| Union | Union
| Protocol | Protocol
let name = function let name = function
| Class -> "class" | Class _ -> "class"
| Struct -> "struct" | Struct -> "struct"
| Union -> "union" | Union -> "union"
| Protocol -> "protocol" | Protocol -> "protocol"
let class_kind_num = function
| CPP -> 1
| Java -> 2
| Objc -> 3
let class_kind_compare ck1 ck2 =
(class_kind_num ck1) - (class_kind_num ck2)
let compare dstruct1 dstruct2 = let compare dstruct1 dstruct2 =
match dstruct1, dstruct2 with match dstruct1, dstruct2 with
| Class, Class -> 0 | Class ck1, Class ck2 -> class_kind_compare ck1 ck2
| Class, _ -> -1 | Class _, _ -> -1
| _, Class -> 1 | _, Class _ -> 1
| Struct, Struct -> 0 | Struct, Struct -> 0
| Struct, _ -> -1 | Struct, _ -> -1
| _, Struct -> 1 | _, Struct -> 1

7
infer/src/backend/csu.mli
Unescape View File

@ -11,8 +11,13 @@
C-style structs struct and union, C-style structs struct and union,
And Objective C protocol *) And Objective C protocol *)
type class_kind =
| CPP
| Java
| Objc
type t = type t =
| Class | Class of class_kind
| Struct | Struct
| Union | Union
| Protocol | Protocol

5
infer/src/backend/localise.ml
Unescape View File

@ -605,10 +605,9 @@ let desc_leak hpred_type_opt value_str_opt resource_opt resource_action_opt loc
let typ_str = let typ_str =
match hpred_type_opt with match hpred_type_opt with
| Some (Sil.Sizeof (Sil.Tstruct | Some (Sil.Sizeof (Sil.Tstruct
{ Sil.csu = Csu.Class; { Sil.csu = Csu.Class _;
Sil.struct_name = Some classname; Sil.struct_name = Some classname;
}, _)) }, _)) ->
when !Config.curr_language = Config.Java ->
" of type " ^ Mangled.to_string classname ^ " " " of type " ^ Mangled.to_string classname ^ " "
| _ -> " " in | _ -> " " in
let desc_str = let desc_str =

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

@ -1454,7 +1454,7 @@ let cloneable_type = Typename.Java.from_string "java.lang.Cloneable"
let is_interface tenv class_name = let is_interface tenv class_name =
match Sil.tenv_lookup tenv class_name with match Sil.tenv_lookup tenv class_name with
| Some (Sil.Tstruct ( { Sil.csu = Csu.Class; struct_name = Some _ } as struct_typ )) -> | Some (Sil.Tstruct ( { Sil.csu = Csu.Class _; struct_name = Some _ } as struct_typ )) ->
(IList.length struct_typ.Sil.instance_fields = 0) && (IList.length struct_typ.Sil.instance_fields = 0) &&
(IList.length struct_typ.Sil.def_methods = 0) (IList.length struct_typ.Sil.def_methods = 0)
| _ -> false | _ -> false
@ -1464,7 +1464,7 @@ let check_subclass_tenv tenv c1 c2 =
let rec check cn = let rec check cn =
Typename.equal cn c2 || Typename.equal c2 object_type || Typename.equal cn c2 || Typename.equal c2 object_type ||
match Sil.tenv_lookup tenv cn with match Sil.tenv_lookup tenv cn with
| Some (Sil.Tstruct { Sil.struct_name = Some _; csu = Csu.Class; superclasses }) -> | Some (Sil.Tstruct { Sil.struct_name = Some _; csu = Csu.Class _; superclasses }) ->
IList.exists check superclasses IList.exists check superclasses
| _ -> false in | _ -> false in
check c1 check c1
@ -1485,10 +1485,10 @@ let check_subtype_basic_type t1 t2 =
(** check if t1 is a subtype of t2 *) (** check if t1 is a subtype of t2 *)
let rec check_subtype tenv t1 t2 = let rec check_subtype tenv t1 t2 =
match t1, t2 with match t1, t2 with
| Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some c1 }, | Sil.Tstruct { Sil.csu = Csu.Class ck1; struct_name = Some c1 },
Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some c2 } -> Sil.Tstruct { Sil.csu = Csu.Class ck2; struct_name = Some c2 } ->
let cn1 = Typename.TN_csu (Csu.Class, c1) let cn1 = Typename.TN_csu (Csu.Class ck1, c1)
and cn2 = Typename.TN_csu (Csu.Class, c2) in and cn2 = Typename.TN_csu (Csu.Class ck2, c2) in
(check_subclass tenv cn1 cn2) (check_subclass tenv cn1 cn2)
| Sil.Tarray (dom_type1, _), Sil.Tarray (dom_type2, _) -> | Sil.Tarray (dom_type1, _), Sil.Tarray (dom_type2, _) ->
@ -1497,8 +1497,8 @@ let rec check_subtype tenv t1 t2 =
| Sil.Tptr (dom_type1, _), Sil.Tptr (dom_type2, _) -> | Sil.Tptr (dom_type1, _), Sil.Tptr (dom_type2, _) ->
check_subtype tenv dom_type1 dom_type2 check_subtype tenv dom_type1 dom_type2
| Sil.Tarray _, Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some c2 } -> | Sil.Tarray _, Sil.Tstruct { Sil.csu = Csu.Class ck2; struct_name = Some c2 } ->
let cn2 = Typename.TN_csu (Csu.Class, c2) in let cn2 = Typename.TN_csu (Csu.Class ck2, c2) in
Typename.equal cn2 serializable_type Typename.equal cn2 serializable_type
|| Typename.equal cn2 cloneable_type || Typename.equal cn2 cloneable_type
|| Typename.equal cn2 object_type || Typename.equal cn2 object_type
@ -1507,10 +1507,10 @@ let rec check_subtype tenv t1 t2 =
let rec case_analysis_type tenv (t1, st1) (t2, st2) = let rec case_analysis_type tenv (t1, st1) (t2, st2) =
match t1, t2 with match t1, t2 with
| Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some c1 }, | Sil.Tstruct { Sil.csu = Csu.Class ck1; struct_name = Some c1 },
Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some c2 } -> Sil.Tstruct { Sil.csu = Csu.Class ck2; struct_name = Some c2 } ->
let cn1 = Typename.TN_csu (Csu.Class, c1) let cn1 = Typename.TN_csu (Csu.Class ck1, c1)
and cn2 = Typename.TN_csu (Csu.Class, c2) in and cn2 = Typename.TN_csu (Csu.Class ck2, c2) in
(Sil.Subtype.case_analysis (cn1, st1) (cn2, st2) (check_subclass tenv) (is_interface tenv)) (Sil.Subtype.case_analysis (cn1, st1) (cn2, st2) (check_subclass tenv) (is_interface tenv))
| Sil.Tarray (dom_type1, _), Sil.Tarray (dom_type2, _) -> | Sil.Tarray (dom_type1, _), Sil.Tarray (dom_type2, _) ->
@ -1519,8 +1519,8 @@ let rec case_analysis_type tenv (t1, st1) (t2, st2) =
| Sil.Tptr (dom_type1, _), Sil.Tptr (dom_type2, _) -> | Sil.Tptr (dom_type1, _), Sil.Tptr (dom_type2, _) ->
(case_analysis_type tenv (dom_type1, st1) (dom_type2, st2)) (case_analysis_type tenv (dom_type1, st1) (dom_type2, st2))
| Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some c1 }, Sil.Tarray _ -> | Sil.Tstruct { Sil.csu = Csu.Class ck1; struct_name = Some c1 }, Sil.Tarray _ ->
let cn1 = Typename.TN_csu (Csu.Class, c1) in let cn1 = Typename.TN_csu (Csu.Class ck1, c1) in
if (Typename.equal cn1 serializable_type if (Typename.equal cn1 serializable_type
|| Typename.equal cn1 cloneable_type || Typename.equal cn1 cloneable_type
|| Typename.equal cn1 object_type) && || Typename.equal cn1 object_type) &&
@ -1869,7 +1869,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 =
Typename.TN_csu (Csu.Class, Mangled.from_string "java.lang.String") in Typename.TN_csu (Csu.Class Csu.Java, 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
@ -1880,7 +1880,8 @@ 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 = Typename.TN_csu (Csu.Class, Mangled.from_string "java.lang.Class") in let class_type =
Typename.TN_csu (Csu.Class Csu.Java, 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

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

@ -851,20 +851,21 @@ let objc_class_annotation =
let cpp_class_annotation = let cpp_class_annotation =
class_annotation cpp_class_str class_annotation cpp_class_str
let is_class_of_language typ class_string = let is_class_of_kind typ ck =
match typ with match typ with
| Tstruct { csu = Csu.Class; struct_annotations } -> | Tstruct { csu = Csu.Class ck' } ->
(match struct_annotations with ck = ck'
| [({ class_name = n; parameters = []}, true)] | _ ->
when n = class_string -> true false
| _ -> false)
| _ -> false
let is_objc_class typ = let is_objc_class typ =
is_class_of_language typ objc_class_str is_class_of_kind typ Csu.Objc
let is_cpp_class typ = let is_cpp_class typ =
is_class_of_language typ cpp_class_str is_class_of_kind typ Csu.CPP
let is_java_class typ =
is_class_of_kind typ Csu.Java
(** turn a *T into a T. fails if [typ] is not a pointer type *) (** turn a *T into a T. fails if [typ] is not a pointer type *)
let typ_strip_ptr = function let typ_strip_ptr = function

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

@ -561,6 +561,8 @@ val is_objc_class : typ -> bool
val is_cpp_class : typ -> bool val is_cpp_class : typ -> bool
val is_java_class : typ -> bool
val exp_is_zero : exp -> bool val exp_is_zero : exp -> bool
val exp_is_null_literal : exp -> bool val exp_is_null_literal : exp -> bool

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

@ -606,7 +606,7 @@ let resolve_method tenv class_name proc_name =
Procname.java_replace_class proc_name (Typename.name class_name) Procname.java_replace_class proc_name (Typename.name class_name)
else Procname.c_method_replace_class proc_name (Typename.name class_name) in else Procname.c_method_replace_class proc_name (Typename.name class_name) in
match Sil.tenv_lookup tenv class_name with match Sil.tenv_lookup tenv class_name with
| Some (Sil.Tstruct { Sil.csu = Csu.Class; def_methods; superclasses }) -> | Some (Sil.Tstruct { Sil.csu = Csu.Class _; def_methods; superclasses }) ->
if method_exists right_proc_name def_methods then if method_exists right_proc_name def_methods then
Some right_proc_name Some right_proc_name
else else
@ -635,8 +635,8 @@ let resolve_typename prop arg =
loop (Prop.get_sigma prop) in loop (Prop.get_sigma prop) in
match typexp_opt with match typexp_opt with
| Some (Sil.Sizeof (Sil.Tstruct { Sil.struct_name = None }, _)) -> None | Some (Sil.Sizeof (Sil.Tstruct { Sil.struct_name = None }, _)) -> None
| Some (Sil.Sizeof (Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some name }, _)) -> | Some (Sil.Sizeof (Sil.Tstruct { Sil.csu = Csu.Class ck; struct_name = Some name }, _)) ->
Some (Typename.TN_csu (Csu.Class, name)) Some (Typename.TN_csu (Csu.Class ck, name))
| _ -> None | _ -> None
(** If the dynamic type of the object calling a method is known, the method from the dynamic type (** If the dynamic type of the object calling a method is known, the method from the dynamic type
@ -659,7 +659,7 @@ let resolve_virtual_pname cfg tenv prop args pname call_flags : Procname.t =
let redirect_shared_ptr tenv cfg pname actual_params = let redirect_shared_ptr tenv cfg pname actual_params =
let class_shared_ptr typ = let class_shared_ptr typ =
try match Sil.expand_type tenv typ with try match Sil.expand_type tenv typ with
| Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some cl_name } -> | Sil.Tstruct { Sil.csu = Csu.Class _; struct_name = Some cl_name } ->
let name = Mangled.to_string cl_name in let name = Mangled.to_string cl_name in
name = "shared_ptr" || name = "__shared_ptr" name = "shared_ptr" || name = "__shared_ptr"
| t -> false | t -> false
@ -723,7 +723,7 @@ let lookup_java_typ_from_string tenv typ_str =
Sil.Tptr (Sil.Tarray (loop stripped_typ, array_typ_size), Sil.Pk_pointer) Sil.Tptr (Sil.Tarray (loop stripped_typ, array_typ_size), Sil.Pk_pointer)
| typ_str -> | typ_str ->
(* non-primitive/non-array type--resolve it in the tenv *) (* non-primitive/non-array type--resolve it in the tenv *)
let typename = Typename.TN_csu (Csu.Class, (Mangled.from_string typ_str)) in let typename = Typename.TN_csu (Csu.Class Csu.Java, (Mangled.from_string typ_str)) in
match Sil.tenv_lookup tenv typename with match Sil.tenv_lookup tenv typename with
| Some (Sil.Tstruct _ as typ) -> typ | Some (Sil.Tstruct _ as typ) -> typ
| _ -> failwith ("Failed to look up typ " ^ typ_str) in | _ -> failwith ("Failed to look up typ " ^ typ_str) in
@ -1030,7 +1030,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 (Typename.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 () =
@ -2508,7 +2508,8 @@ 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 (Typename.TN_csu (Csu.Class, Mangled.from_string "NSArray")) in let nsarray_typ =
Sil.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, 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
@ -2535,7 +2536,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 (Typename.TN_csu (Csu.Class, Mangled.from_string "NSDictionary")) in Sil.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, 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

2
infer/src/backend/tabulation.ml
Unescape View File

@ -599,7 +599,7 @@ let prop_get_exn_name pname prop =
let do_hpred = function let do_hpred = function
| Sil.Hpointsto (e1, _, Sil.Sizeof (Sil.Tstruct { Sil.struct_name = Some name }, _)) | Sil.Hpointsto (e1, _, Sil.Sizeof (Sil.Tstruct { Sil.struct_name = Some name }, _))
when Sil.exp_equal e1 e -> when Sil.exp_equal e1 e ->
let found_exn_name = Typename.TN_csu (Csu.Class, name) in let found_exn_name = Typename.TN_csu (Csu.Class Csu.Java, name) in
exn_name := found_exn_name exn_name := found_exn_name
| _ -> () in | _ -> () in
IList.iter do_hpred (Prop.get_sigma prop) in IList.iter do_hpred (Prop.get_sigma prop) in

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

@ -99,8 +99,8 @@ struct
let rec type_to_string typ = let rec type_to_string typ =
match typ with match typ with
| Sil.Tptr (typ , _) -> type_to_string typ | Sil.Tptr (typ , _) -> type_to_string typ
| Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some mangled } | Sil.Tstruct { Sil.csu = Csu.Class _; struct_name = Some mangled }
| Sil.Tvar (Typename.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) =
@ -311,7 +311,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 { Sil.csu = Csu.Class; struct_name = Some _; superclasses = class_name :: _ } -> | Sil.Tstruct { Sil.csu = Csu.Class _; struct_name = Some _; superclasses = class_name :: _ } ->
Sil.tenv_lookup tenv class_name Sil.tenv_lookup tenv class_name
| Sil.Tarray (dom_type, _) -> None | Sil.Tarray (dom_type, _) -> None
| Sil.Tptr (dom_type, p) -> | Sil.Tptr (dom_type, p) ->
@ -412,7 +412,8 @@ struct
| Sil.Cfun fn -> assert false | Sil.Cfun fn -> assert false
| Sil.Cstr str -> | Sil.Cstr str ->
Sil.Tptr ( Sil.Tptr (
Sil.Tvar ( Typename.TN_csu (Csu.Class, (Mangled.from_string ( "java.lang.String")))), Sil.Tvar (Typename.TN_csu
(Csu.Class Csu.Java, (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

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

@ -48,7 +48,7 @@ module Java =
struct struct
let from_string class_name_str = let from_string class_name_str =
TN_csu (Csu.Class, Mangled.from_string class_name_str) TN_csu (Csu.Class Csu.Java, Mangled.from_string class_name_str)
end end

3
infer/src/checkers/callbackChecker.ml
Unescape View File

@ -81,7 +81,8 @@ let do_eradicate_check all_procs get_procdesc idenv tenv =
* fields that are nullified *) * fields that are nullified *)
let callback_checker_main all_procs get_procdesc idenv tenv proc_name proc_desc = let callback_checker_main all_procs get_procdesc idenv tenv proc_name proc_desc =
let typename = let typename =
Typename.TN_csu (Csu.Class, Mangled.from_string (Procname.java_get_class proc_name)) in Typename.TN_csu
(Csu.Class Csu.Java, Mangled.from_string (Procname.java_get_class proc_name)) in
match Sil.tenv_lookup tenv typename with match Sil.tenv_lookup tenv typename with
| Some (Sil.Tstruct { Sil.csu; struct_name = Some class_name; def_methods } as typ) -> | Some (Sil.Tstruct { Sil.csu; struct_name = Some class_name; def_methods } as typ) ->
let lifecycle_typs = get_or_create_lifecycle_typs tenv in let lifecycle_typs = get_or_create_lifecycle_typs tenv in

3
infer/src/checkers/checkers.ml
Unescape View File

@ -198,7 +198,8 @@ let callback_check_write_to_parcel all_procs get_proc_desc idenv tenv proc_name
let method_match () = Procname.java_get_method proc_name = "writeToParcel" in let method_match () = Procname.java_get_method proc_name = "writeToParcel" in
let expr_match () = Sil.exp_is_this this_expr in let expr_match () = Sil.exp_is_this this_expr in
let type_match () = let type_match () =
let class_name = Typename.TN_csu (Csu.Class, Mangled.from_string "android.os.Parcelable") in let class_name =
Typename.TN_csu (Csu.Class Csu.Java, Mangled.from_string "android.os.Parcelable") in
PatternMatch.is_direct_subtype_of this_type class_name in PatternMatch.is_direct_subtype_of this_type class_name in
method_match () && expr_match () && type_match () in method_match () && expr_match () && type_match () in

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

@ -46,7 +46,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 { Sil.struct_name = Some cn }, _) -> | Sil.Tptr (Sil.Tstruct { Sil.struct_name = Some cn }, _) ->
Some cn Some cn
| Sil.Tptr (Sil.Tvar (Typename.TN_csu (Csu.Class, cn)), _) -> | Sil.Tptr (Sil.Tvar (Typename.TN_csu (Csu.Class _, cn)), _) ->
Some cn Some cn
| _ -> None | _ -> None
@ -229,7 +229,7 @@ let type_is_class = function
let initializer_classes = let initializer_classes =
IList.map IList.map
(fun name -> Typename.TN_csu (Csu.Class, Mangled.from_string name)) (fun name -> Typename.TN_csu (Csu.Class Csu.Java, Mangled.from_string name))
[ [
"android.app.Activity"; "android.app.Activity";
"android.app.Application"; "android.app.Application";
@ -322,7 +322,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
Typename.TN_csu (Csu.Class, Mangled.from_string class_name) in Typename.TN_csu (Csu.Class Csu.Java, 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/checkers/performanceCritical.ml
Unescape View File

@ -79,7 +79,7 @@ let is_modeled_expensive tenv pname =
| Some p -> p in | Some p -> p in
let classname = let classname =
Mangled.from_package_class package (Procname.java_get_simple_class pname) in Mangled.from_package_class package (Procname.java_get_simple_class pname) in
match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class, classname)) with match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, classname)) with
| None -> false | None -> false
| Some typ -> | Some typ ->
AndroidFramework.is_view typ tenv AndroidFramework.is_view typ tenv

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

@ -117,8 +117,8 @@ let curr_class_hash curr_class =
| ContextProtocol name -> Hashtbl.hash name | ContextProtocol name -> Hashtbl.hash name
| ContextNoCls -> Hashtbl.hash "no class" | ContextNoCls -> Hashtbl.hash "no class"
let create_curr_class tenv class_name = let create_curr_class tenv class_name ck =
let class_tn_name = Typename.TN_csu (Csu.Class, (Mangled.from_string class_name)) in let class_tn_name = Typename.TN_csu (Csu.Class ck, (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 { Sil.superclasses } -> | Some Sil.Tstruct { Sil.superclasses } ->
(let superclasses_names = IList.map Typename.name superclasses in (let superclasses_names = IList.map Typename.name superclasses in

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

@ -56,7 +56,7 @@ val get_tenv : t -> Sil.tenv
val create_context : Sil.tenv -> Cg.t -> Cfg.cfg -> Cfg.Procdesc.t -> val create_context : Sil.tenv -> Cg.t -> Cfg.cfg -> Cfg.Procdesc.t ->
curr_class -> has_return_param : bool -> bool -> t option -> t curr_class -> has_return_param : bool -> bool -> t option -> t
val create_curr_class : Sil.tenv -> string -> curr_class val create_curr_class : Sil.tenv -> string -> Csu.class_kind -> curr_class
val add_block_static_var : t -> Procname.t -> (Sil.pvar * Sil.typ) -> unit val add_block_static_var : t -> Procname.t -> (Sil.pvar * Sil.typ) -> unit

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

@ -26,12 +26,12 @@ let rec get_fields_super_classes tenv super_class =
| Some Sil.Tstruct { Sil.instance_fields } -> instance_fields | Some Sil.Tstruct { Sil.instance_fields } -> instance_fields
| Some _ -> [] | Some _ -> []
let fields_superclass tenv interface_decl_info = let fields_superclass tenv interface_decl_info ck =
match interface_decl_info.Clang_ast_t.otdi_super with match interface_decl_info.Clang_ast_t.otdi_super with
| Some dr -> | Some dr ->
(match dr.Clang_ast_t.dr_name with (match dr.Clang_ast_t.dr_name with
| Some sc -> | Some sc ->
let classname = CTypes.mk_classname (Ast_utils.get_qualified_name sc) in let classname = CTypes.mk_classname (Ast_utils.get_qualified_name sc) ck in
get_fields_super_classes tenv classname get_fields_super_classes tenv classname
| _ -> []) | _ -> [])
| _ -> [] | _ -> []
@ -75,9 +75,9 @@ let rec get_fields type_ptr_to_sil_type tenv curr_class decl_list =
(* Add potential extra fields defined only in the implementation of the class *) (* Add potential extra fields defined only in the implementation of the class *)
(* 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 ck fields =
let mang_name = Mangled.from_string class_name in let mang_name = Mangled.from_string class_name in
let class_tn_name = Typename.TN_csu (Csu.Class, mang_name) in let class_tn_name = Typename.TN_csu (Csu.Class ck, mang_name) in
match Sil.tenv_lookup tenv class_tn_name with match Sil.tenv_lookup tenv class_tn_name with
| Some Sil.Tstruct ({ Sil.instance_fields } as struct_typ) -> | Some Sil.Tstruct ({ Sil.instance_fields } as struct_typ) ->
let new_fields = General_utils.append_no_duplicates_fields fields instance_fields in let new_fields = General_utils.append_no_duplicates_fields fields instance_fields in
@ -87,7 +87,7 @@ let add_missing_fields tenv class_name fields =
{ struct_typ with { struct_typ with
Sil.instance_fields = new_fields; Sil.instance_fields = new_fields;
static_fields = []; static_fields = [];
csu = Csu.Class; csu = Csu.Class ck;
struct_name = Some mang_name; struct_name = Some mang_name;
} in } in
Printing.log_out " Updating info for class '%s' in tenv\n" class_name; Printing.log_out " Updating info for class '%s' in tenv\n" class_name;
@ -122,6 +122,6 @@ let get_property_corresponding_ivar tenv type_ptr_to_sil_type class_name propert
let prop_attributes = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in let prop_attributes = obj_c_property_decl_info.Clang_ast_t.opdi_property_attributes in
let field_name, typ, attr = build_sil_field type_ptr_to_sil_type tenv let field_name, typ, attr = build_sil_field type_ptr_to_sil_type tenv
field_name_str type_ptr prop_attributes in field_name_str type_ptr prop_attributes in
ignore (add_missing_fields tenv class_name [(field_name, typ, attr)]); ignore (add_missing_fields tenv class_name Csu.Objc [(field_name, typ, attr)]);
field_name) field_name)
| _ -> assert false | _ -> assert false

8
infer/src/clang/cField_decl.mli
Unescape View File

@ -10,20 +10,18 @@
(** Utility module to retrieve fields of structs of classes *) (** Utility module to retrieve fields of structs of classes *)
open CFrontend_utils open CFrontend_utils
val fields_superclass : Sil.tenv -> Clang_ast_t.obj_c_interface_decl_info ->
(Ident.fieldname * Sil.typ * Sil.item_annotation) list
type field_type = Ident.fieldname * Sil.typ * (Sil.annotation * bool) list type field_type = Ident.fieldname * Sil.typ * (Sil.annotation * bool) list
val get_fields : Ast_utils.type_ptr_to_sil_type -> Sil.tenv -> CContext.curr_class -> val get_fields : Ast_utils.type_ptr_to_sil_type -> Sil.tenv -> CContext.curr_class ->
Clang_ast_t.decl list -> field_type list Clang_ast_t.decl list -> field_type list
val fields_superclass : Sil.tenv -> Clang_ast_t.obj_c_interface_decl_info -> field_type list val fields_superclass :
Sil.tenv -> Clang_ast_t.obj_c_interface_decl_info -> Csu.class_kind -> field_type list
val build_sil_field : Ast_utils.type_ptr_to_sil_type -> Sil.tenv -> Clang_ast_t.named_decl_info -> val build_sil_field : Ast_utils.type_ptr_to_sil_type -> Sil.tenv -> Clang_ast_t.named_decl_info ->
Clang_ast_t.type_ptr -> Clang_ast_t.property_attribute list -> field_type Clang_ast_t.type_ptr -> Clang_ast_t.property_attribute list -> field_type
val add_missing_fields : Sil.tenv -> string -> field_type list -> unit val add_missing_fields : Sil.tenv -> string -> Csu.class_kind -> field_type list -> unit
val is_ivar_atomic : Ident.fieldname -> Sil.struct_fields -> bool val is_ivar_atomic : Ident.fieldname -> Sil.struct_fields -> bool

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 = Typename.TN_csu (Csu.Class, Mangled.from_string cname) in let tname = Typename.TN_csu (Csu.Class Csu.Objc, 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 { Sil.instance_fields; static_fields } -> | Some Sil.Tstruct { Sil.instance_fields; static_fields } ->

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

@ -43,7 +43,7 @@ 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
| Typename.TN_csu (Csu.Class, _) | Typename.TN_csu (Csu.Protocol, _) -> | Typename.TN_csu (Csu.Class _, _) | Typename.TN_csu (Csu.Protocol, _) ->
(match typ with (match typ with
| Sil.Tstruct { Sil.instance_fields; superclasses; def_methods; struct_annotations } -> | Sil.Tstruct { Sil.instance_fields; superclasses; def_methods; struct_annotations } ->
print_endline ( print_endline (

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

@ -218,9 +218,9 @@ let get_method_name_from_clang tenv ms_opt =
| None -> Some ms) | None -> Some ms)
| None -> None | None -> None
let get_superclass_curr_class context = let get_superclass_curr_class_objc context =
let retrive_super cname super_opt = let retrive_super cname super_opt =
let iname = Typename.TN_csu (Csu.Class, Mangled.from_string cname) in let iname = Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string cname) in
Printing.log_out "Checking for superclass = '%s'\n\n%!" (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 { Sil.superclasses = super_name :: _ } -> | Some Sil.Tstruct { Sil.superclasses = super_name :: _ } ->
@ -260,8 +260,8 @@ let get_class_name_method_call_from_receiver_kind context obj_c_message_expr_inf
| (instance_obj, Sil.Tptr(t, _)):: _ | (instance_obj, Sil.Tptr(t, _)):: _
| (instance_obj, t):: _ -> CTypes.classname_of_type t | (instance_obj, t):: _ -> CTypes.classname_of_type t
| _ -> assert false) | _ -> assert false)
| `SuperInstance ->get_superclass_curr_class context | `SuperInstance ->get_superclass_curr_class_objc context
| `SuperClass -> get_superclass_curr_class context | `SuperClass -> get_superclass_curr_class_objc context
let get_objc_method_data obj_c_message_expr_info = let get_objc_method_data obj_c_message_expr_info =
let selector = obj_c_message_expr_info.Clang_ast_t.omei_selector in let selector = obj_c_message_expr_info.Clang_ast_t.omei_selector in

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

@ -121,13 +121,13 @@ struct
let block_type = Sil.Tstruct let block_type = Sil.Tstruct
{ Sil.instance_fields = fields; { Sil.instance_fields = fields;
static_fields = []; static_fields = [];
csu = Csu.Class; csu = Csu.Class Csu.Objc;
struct_name = Some mblock; struct_name = Some mblock;
superclasses = []; superclasses = [];
def_methods = []; def_methods = [];
struct_annotations = []; struct_annotations = [];
} in } in
let block_name = Typename.TN_csu (Csu.Class, mblock) in let block_name = Typename.TN_csu (Csu.Class Csu.Objc, 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
@ -430,7 +430,7 @@ struct
raise (Self.SelfClassException (CContext.get_curr_class_name curr_class)) raise (Self.SelfClassException (CContext.get_curr_class_name curr_class))
else else
let typ = CTypes.add_pointer_to_typ let typ = CTypes.add_pointer_to_typ
(CTypes_decl.get_type_curr_class context.tenv curr_class) in (CTypes_decl.get_type_curr_class_objc context.tenv curr_class) in
[(e, typ)] [(e, typ)]
else [(e, typ)] in else [(e, typ)] in
Printing.log_out "\n\n PVAR ='%s'\n\n" (Sil.pvar_to_string pvar); Printing.log_out "\n\n PVAR ='%s'\n\n" (Sil.pvar_to_string pvar);
@ -904,8 +904,9 @@ struct
else if (selector = CFrontend_config.alloc) || (selector = CFrontend_config.new_str) then else if (selector = CFrontend_config.alloc) || (selector = CFrontend_config.new_str) then
match receiver_kind with match receiver_kind with
| `Class type_ptr -> | `Class type_ptr ->
let class_opt = CMethod_trans.get_class_name_method_call_from_clang context.tenv let class_opt =
obj_c_message_expr_info in CMethod_trans.get_class_name_method_call_from_clang
context.CContext.tenv obj_c_message_expr_info in
Some (new_or_alloc_trans trans_state_pri sil_loc si type_ptr class_opt selector) Some (new_or_alloc_trans trans_state_pri sil_loc si type_ptr class_opt selector)
| _ -> None | _ -> None
(* assertions *) (* assertions *)
@ -1568,13 +1569,17 @@ struct
(* variable might be initialized already - do nothing in that case*) (* variable might be initialized already - do nothing in that case*)
if IList.exists (Sil.exp_equal var_exp) res_trans_ie.initd_exps then ([], [], []) if IList.exists (Sil.exp_equal var_exp) res_trans_ie.initd_exps then ([], [], [])
else if !Config.arc_mode && else if !Config.arc_mode &&
(CTrans_utils.is_method_call ie || ObjcInterface_decl.is_pointer_to_objc_class context.CContext.tenv ie_typ) then (CTrans_utils.is_method_call ie ||
ObjcInterface_decl.is_pointer_to_objc_class context.CContext.tenv ie_typ)
then
(* In arc mode, if it's a method call or we are initializing with a pointer to objc class *) (* In arc mode, if it's a method call or we are initializing with a pointer to objc class *)
(* we need to add retain/release *) (* we need to add retain/release *)
let (e, instrs, ids) = let (e, instrs, ids) =
CArithmetic_trans.assignment_arc_mode context var_exp ie_typ sil_e1' sil_loc rhs_owning_method true in CArithmetic_trans.assignment_arc_mode
context var_exp ie_typ sil_e1' sil_loc rhs_owning_method true in
([(e, ie_typ)], instrs, ids) ([(e, ie_typ)], instrs, ids)
else ([], [Sil.Set (var_exp, ie_typ, sil_e1', sil_loc)], []) in else
([], [Sil.Set (var_exp, ie_typ, sil_e1', sil_loc)], []) in
let res_trans_assign = { empty_res_trans with let res_trans_assign = { empty_res_trans with
ids = ids_assign; ids = ids_assign;
instrs = instrs_assign } in instrs = instrs_assign } in

3
infer/src/clang/cTrans_utils.ml
Unescape View File

@ -535,7 +535,8 @@ struct
if is_superinstance mei then if is_superinstance mei then
let typ, self_expr, id, ins = let typ, self_expr, id, ins =
let t' = CTypes.add_pointer_to_typ let t' = CTypes.add_pointer_to_typ
(CTypes_decl.get_type_curr_class context.CContext.tenv context.CContext.curr_class) in (CTypes_decl.get_type_curr_class_objc
context.CContext.tenv context.CContext.curr_class) in
let e = Sil.Lvar (Sil.mk_pvar (Mangled.from_string CFrontend_config.self) procname) in let e = Sil.Lvar (Sil.mk_pvar (Mangled.from_string CFrontend_config.self) procname) in
let id = Ident.create_fresh Ident.knormal in let id = Ident.create_fresh Ident.knormal in
t', Sil.Var id, [id], [Sil.Letderef (id, e, t', loc)] in t', Sil.Var id, [id], [Sil.Letderef (id, e, t', loc)] in

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

@ -174,7 +174,9 @@ and type_ptr_to_sil_type translate_decl tenv type_ptr =
| `PointerOf typ -> | `PointerOf typ ->
let sil_typ = type_ptr_to_sil_type translate_decl tenv typ in let sil_typ = type_ptr_to_sil_type translate_decl tenv typ in
Sil.Tptr (sil_typ, Sil.Pk_pointer) Sil.Tptr (sil_typ, Sil.Pk_pointer)
| `ClassType name -> Sil.Tvar (CTypes.mk_classname name) | `ClassType name ->
(* TODO: make the class kind a parameter of the function, instead of a constant Csu.Objc *)
Sil.Tvar (CTypes.mk_classname name Csu.Objc)
| `StructType name -> Sil.Tvar (CTypes.mk_structname name) | `StructType name -> Sil.Tvar (CTypes.mk_structname name)
| `DeclPtr ptr -> decl_ptr_to_sil_type translate_decl tenv ptr | `DeclPtr ptr -> decl_ptr_to_sil_type translate_decl tenv ptr
| `ErrorType -> Sil.Tvoid | `ErrorType -> Sil.Tvoid

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

@ -65,7 +65,7 @@ let search_enum_type_by_name tenv name =
Sil.tenv_iter f tenv; Sil.tenv_iter f tenv;
!found !found
let mk_classname n = Typename.TN_csu (Csu.Class, Mangled.from_string n) let mk_classname n ck = Typename.TN_csu (Csu.Class ck, Mangled.from_string n)
let mk_structname n = Typename.TN_csu (Csu.Struct, Mangled.from_string n) let mk_structname n = Typename.TN_csu (Csu.Struct, Mangled.from_string n)

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

@ -15,7 +15,7 @@ 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 -> Typename.t val mk_classname : string -> Csu.class_kind -> Typename.t
val mk_structname : string -> Typename.t val mk_structname : string -> Typename.t

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

@ -17,7 +17,7 @@ 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 = Typename.TN_csu (Csu.Class, objc_class_mangled) in let objc_class_name = Typename.TN_csu (Csu.Class Csu.Objc, objc_class_mangled) in
let objc_class_type_info = let objc_class_type_info =
Sil.Tstruct { Sil.Tstruct {
Sil.instance_fields = []; Sil.instance_fields = [];
@ -65,7 +65,7 @@ let add_predefined_basic_types tenv =
Ast_utils.update_sil_types_map tp return_type in Ast_utils.update_sil_types_map tp return_type in
let sil_void_type = CType_to_sil_type.sil_type_of_builtin_type_kind `Void in let sil_void_type = CType_to_sil_type.sil_type_of_builtin_type_kind `Void in
let sil_char_type = CType_to_sil_type.sil_type_of_builtin_type_kind `Char_S in let sil_char_type = CType_to_sil_type.sil_type_of_builtin_type_kind `Char_S in
let sil_nsarray_type = Sil.Tvar (CTypes.mk_classname CFrontend_config.nsarray_cl) in let sil_nsarray_type = Sil.Tvar (CTypes.mk_classname CFrontend_config.nsarray_cl Csu.Objc) in
let sil_id_type = CType_to_sil_type.get_builtin_objc_type `ObjCId in let sil_id_type = CType_to_sil_type.get_builtin_objc_type `ObjCId in
add_basic_type create_int_type `Int; add_basic_type create_int_type `Int;
add_basic_type create_void_type `Void; add_basic_type create_void_type `Void;
@ -90,7 +90,7 @@ let create_csu opt_type =
(let buf = Str.split (Str.regexp "[ \t]+") s in (let buf = Str.split (Str.regexp "[ \t]+") s in
match buf with match buf with
| "struct":: l ->Csu.Struct | "struct":: l ->Csu.Struct
| "class":: l -> Csu.Class | "class":: l -> Csu.Class Csu.CPP
| "union":: l -> Csu.Union | "union":: l -> Csu.Union
| _ -> Csu.Struct) | _ -> Csu.Struct)
| _ -> assert false | _ -> assert false
@ -107,7 +107,7 @@ let get_record_name_csu decl =
name_info, opt_type, not cxx_record_info.xrdi_is_c_like name_info, opt_type, not cxx_record_info.xrdi_is_c_like
| _-> assert false in | _-> assert false in
let csu = create_csu opt_type in let csu = create_csu opt_type in
let csu' = if should_be_class then Csu.Class else csu in let csu' = if should_be_class then Csu.Class Csu.CPP else csu in
let name = Ast_utils.get_qualified_name name_info in let name = Ast_utils.get_qualified_name name_info in
csu', name csu', name
@ -140,10 +140,11 @@ let get_superclass_decls decl =
| _ -> [] | _ -> []
(** fetches list of superclasses for C++ classes *) (** fetches list of superclasses for C++ classes *)
let get_superclass_list decl = let get_superclass_list_cpp decl =
let base_decls = get_superclass_decls decl in let base_decls = get_superclass_decls decl in
let decl_to_mangled_name decl = Mangled.from_string (get_record_name decl) in let decl_to_mangled_name decl = Mangled.from_string (get_record_name decl) in
let get_super_field super_decl = Typename.TN_csu (Csu.Class, decl_to_mangled_name super_decl) in let get_super_field super_decl =
Typename.TN_csu (Csu.Class Csu.CPP, decl_to_mangled_name super_decl) in
IList.map get_super_field base_decls IList.map get_super_field base_decls
let add_struct_to_tenv tenv typ = let add_struct_to_tenv tenv typ =
@ -194,9 +195,9 @@ and get_struct_cpp_class_declaration_type tenv decl =
let sorted_non_static_fields = CFrontend_utils.General_utils.sort_fields non_static_fields' in let sorted_non_static_fields = CFrontend_utils.General_utils.sort_fields non_static_fields' in
let static_fields = [] in (* Warning for the moment we do not treat static field. *) let static_fields = [] in (* Warning for the moment we do not treat static field. *)
let def_methods = get_class_methods tenv name decl_list in (* C++ methods only *) let def_methods = get_class_methods tenv name decl_list in (* C++ methods only *)
let superclasses = get_superclass_list decl in let superclasses = get_superclass_list_cpp decl in
let struct_annotations = let struct_annotations =
if csu = Csu.Class then Sil.cpp_class_annotation if csu = Csu.Class Csu.CPP then Sil.cpp_class_annotation
else Sil.item_annotation_empty in (* No annotations for structs *) else Sil.item_annotation_empty in (* No annotations for structs *)
let sil_type = Sil.Tstruct let sil_type = Sil.Tstruct
{ Sil.instance_fields = sorted_non_static_fields; { Sil.instance_fields = sorted_non_static_fields;
@ -250,7 +251,7 @@ let get_class_type_np tenv expr_info obj_c_message_expr_info =
| _ -> expr_info.Clang_ast_t.ei_type_ptr in | _ -> expr_info.Clang_ast_t.ei_type_ptr in
type_ptr_to_sil_type tenv tp type_ptr_to_sil_type tenv tp
let get_type_curr_class tenv curr_class_opt = let get_type_curr_class_objc 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 (Typename.TN_csu (Csu.Class, (Mangled.from_string name))) in let typ = Sil.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, (Mangled.from_string name))) in
CTypes.expand_structured_type tenv typ CTypes.expand_structured_type tenv typ

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

@ -26,7 +26,7 @@ val class_from_pointer_type : Sil.tenv -> Clang_ast_t.type_ptr -> string
val get_class_type_np : Sil.tenv -> Clang_ast_t.expr_info -> val get_class_type_np : Sil.tenv -> Clang_ast_t.expr_info ->
Clang_ast_t.obj_c_message_expr_info -> Sil.typ Clang_ast_t.obj_c_message_expr_info -> Sil.typ
val get_type_curr_class : Sil.tenv -> CContext.curr_class -> Sil.typ val get_type_curr_class_objc : Sil.tenv -> CContext.curr_class -> Sil.typ
val get_type_from_expr_info : Clang_ast_t.expr_info -> Sil.tenv -> Sil.typ val get_type_from_expr_info : Clang_ast_t.expr_info -> Sil.tenv -> Sil.typ

4
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 = Typename.TN_csu (Csu.Class, mang_name) in let class_tn_name = Typename.TN_csu (Csu.Class Csu.Objc, 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
@ -87,7 +87,7 @@ let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list =
Sil.Tstruct { struct_typ with Sil.Tstruct { struct_typ with
Sil.instance_fields = new_fields; Sil.instance_fields = new_fields;
static_fields = []; static_fields = [];
csu = Csu.Class; csu = Csu.Class Csu.Objc;
struct_name = Some mang_name; struct_name = Some mang_name;
def_methods = new_methods; def_methods = new_methods;
} in } in

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

@ -21,8 +21,8 @@ module L = Logging
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 (Typename.TN_csu (Csu.Class, cname)), _) -> | Sil.Tptr (Sil.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, cname)), _) ->
(match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class, cname)) with (match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Objc, cname)) with
| Some typ when Sil.is_objc_class typ -> true | Some typ when Sil.is_objc_class typ -> true
| _ -> false) | _ -> false)
| Sil.Tptr (typ, _) when Sil.is_objc_class typ -> true | Sil.Tptr (typ, _) when Sil.is_objc_class typ -> true
@ -81,7 +81,7 @@ let get_interface_superclasses super_opt protocols =
let super_class = let super_class =
match super_opt with match super_opt with
| None -> [] | None -> []
| Some super -> [Typename.TN_csu (Csu.Class, Mangled.from_string super)] in | Some super -> [Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string super)] in
let protocol_names = IList.map ( let protocol_names = IList.map (
fun name -> Typename.TN_csu (Csu.Protocol, Mangled.from_string name) fun name -> Typename.TN_csu (Csu.Protocol, Mangled.from_string name)
) protocols in ) protocols in
@ -99,7 +99,7 @@ let create_superclasses_fields type_ptr_to_sil_type tenv curr_class decl_list cl
(* Adds pairs (interface name, interface_type_info) to the global environment. *) (* Adds pairs (interface name, interface_type_info) to the global environment. *)
let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name decl_list ocidi = let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name decl_list ocidi =
Printing.log_out "ADDING: ObjCInterfaceDecl for '%s'\n" class_name; Printing.log_out "ADDING: ObjCInterfaceDecl for '%s'\n" class_name;
let interface_name = CTypes.mk_classname class_name in let interface_name = CTypes.mk_classname class_name Csu.Objc 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 interface_name); Ast_utils.update_sil_types_map decl_key (Sil.Tvar interface_name);
let superclasses, fields = let superclasses, fields =
@ -107,7 +107,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name
ocidi.Clang_ast_t.otdi_super ocidi.Clang_ast_t.otdi_super
ocidi.Clang_ast_t.otdi_protocols in ocidi.Clang_ast_t.otdi_protocols in
let methods = ObjcProperty_decl.get_methods curr_class decl_list in let methods = ObjcProperty_decl.get_methods curr_class decl_list in
let fields_sc = CField_decl.fields_superclass tenv ocidi in let fields_sc = CField_decl.fields_superclass tenv ocidi Csu.Objc in
IList.iter (fun (fn, ft, _) -> IList.iter (fun (fn, ft, _) ->
Printing.log_out "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn); Printing.log_out "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn);
Printing.log_out "type: '%s'\n" (Sil.typ_to_string ft)) fields_sc; Printing.log_out "type: '%s'\n" (Sil.typ_to_string ft)) fields_sc;
@ -130,7 +130,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name
Sil.Tstruct { Sil.Tstruct {
Sil.instance_fields = fields; Sil.instance_fields = fields;
static_fields = []; static_fields = [];
csu = Csu.Class; csu = Csu.Class Csu.Objc;
struct_name = Some (Mangled.from_string class_name); struct_name = Some (Mangled.from_string class_name);
superclasses; superclasses;
def_methods = methods; def_methods = methods;
@ -144,15 +144,15 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name
| None -> Printing.log_out " >>>NOT Found!!\n"); | None -> Printing.log_out " >>>NOT Found!!\n");
Sil.Tvar interface_name Sil.Tvar interface_name
let add_missing_methods tenv class_name decl_info decl_list curr_class = let add_missing_methods tenv class_name ck 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 = Typename.TN_csu (Csu.Class, (Mangled.from_string class_name)) in let class_tn_name = Typename.TN_csu (Csu.Class ck, (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
| Some Sil.Tstruct | Some Sil.Tstruct
({ Sil.static_fields = []; ({ Sil.static_fields = [];
csu = Csu.Class; csu = Csu.Class ck;
struct_name = Some name; struct_name = Some name;
def_methods; def_methods;
} as struct_typ) -> } as struct_typ) ->
@ -192,7 +192,7 @@ let interface_impl_declaration type_ptr_to_sil_type tenv decl =
let _ = add_class_decl type_ptr_to_sil_type tenv idi in let _ = add_class_decl type_ptr_to_sil_type tenv idi in
let curr_class = get_curr_class_impl idi in let curr_class = get_curr_class_impl idi in
let fields = CField_decl.get_fields type_ptr_to_sil_type tenv curr_class decl_list in let fields = CField_decl.get_fields type_ptr_to_sil_type tenv curr_class decl_list in
CField_decl.add_missing_fields tenv class_name fields; CField_decl.add_missing_fields tenv class_name Csu.Objc fields;
let typ = add_missing_methods tenv class_name decl_info decl_list curr_class in let typ = add_missing_methods tenv class_name Csu.Objc decl_info decl_list curr_class in
typ typ
| _ -> assert false | _ -> assert false

2
infer/src/eradicate/eradicateChecks.ml
Unescape View File

@ -134,7 +134,7 @@ let check_condition case_zero find_canonical_duplicate get_proc_desc curr_pname
let throwable_found = ref false in let throwable_found = ref false in
let throwable_class = Mangled.from_string "java.lang.Throwable" in let throwable_class = Mangled.from_string "java.lang.Throwable" in
let typ_is_throwable = function let typ_is_throwable = function
| Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some c } -> | Sil.Tstruct { Sil.csu = Csu.Class _; struct_name = Some c } ->
Mangled.equal c throwable_class Mangled.equal c throwable_class
| _ -> false in | _ -> false in
let do_instr = function let do_instr = function

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

@ -253,7 +253,7 @@ let android_callbacks =
(* TODO (t4644852): factor out subtyping functions into some sort of JavaUtil module *) (* TODO (t4644852): factor out subtyping functions into some sort of JavaUtil module *)
let get_all_supertypes typ tenv = let get_all_supertypes typ tenv =
let get_direct_supers = function let get_direct_supers = function
| Sil.Tstruct { Sil.csu = Csu.Class; superclasses } -> | Sil.Tstruct { Sil.csu = Csu.Class _; superclasses } ->
superclasses superclasses
| _ -> [] in | _ -> [] in
let rec add_typ class_name typs = let rec add_typ class_name typs =
@ -273,7 +273,7 @@ let is_subtype (typ0 : Sil.typ) (typ1 : Sil.typ) tenv =
let is_subtype_package_class typ package classname tenv = let is_subtype_package_class typ package classname tenv =
let classname = Mangled.from_package_class package classname in let classname = Mangled.from_package_class package classname in
match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class, classname)) with match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, classname)) with
| Some found_typ -> is_subtype typ found_typ tenv | Some found_typ -> is_subtype typ found_typ tenv
| _ -> false | _ -> false
@ -296,7 +296,7 @@ let is_callback_class_name class_name = Mangled.MangledSet.mem class_name androi
let is_callback_class typ tenv = let is_callback_class typ tenv =
let supertyps = get_all_supertypes typ tenv in let supertyps = get_all_supertypes typ tenv in
TypSet.exists (fun typ -> match typ with TypSet.exists (fun typ -> match typ with
| Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some classname } -> | Sil.Tstruct { Sil.csu = Csu.Class _; struct_name = Some classname } ->
is_callback_class_name classname is_callback_class_name classname
| _ -> false) supertyps | _ -> false) supertyps
@ -356,9 +356,9 @@ let is_callback_register_method procname args tenv =
(** given an Android framework type mangled string [lifecycle_typ] (e.g., android.app.Activity) and (** given an Android framework type mangled string [lifecycle_typ] (e.g., android.app.Activity) and
a list of method names [lifecycle_procs_strs], get the appropriate typ and procnames *) a list of method names [lifecycle_procs_strs], get the appropriate typ and procnames *)
let get_lifecycle_for_framework_typ_opt lifecycle_typ lifecycle_proc_strs tenv = let get_lifecycle_for_framework_typ_opt lifecycle_typ lifecycle_proc_strs tenv =
match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class, lifecycle_typ)) with match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, lifecycle_typ)) with
| Some (Sil.Tstruct | Some (Sil.Tstruct
{ Sil.csu = Csu.Class; struct_name = Some _; def_methods } as lifecycle_typ) -> { Sil.csu = Csu.Class _; struct_name = Some _; def_methods } as lifecycle_typ) ->
(* TODO (t4645631): collect the procedures for which is_java is returning false *) (* TODO (t4645631): collect the procedures for which is_java is returning false *)
let lookup_proc lifecycle_proc = let lookup_proc lifecycle_proc =
IList.find (fun decl_proc -> IList.find (fun decl_proc ->

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

@ -118,8 +118,8 @@ let find_registered_callbacks lifecycle_trace harness_name proc_file_map tenv =
(** if [typ] is a lifecycle type, generate a list of (method call, receiver) pairs constituting a (** if [typ] is a lifecycle type, generate a list of (method call, receiver) pairs constituting a
lifecycle trace *) lifecycle trace *)
let try_create_lifecycle_trace typ lifecycle_typ lifecycle_procs proc_file_map tenv = match typ with let try_create_lifecycle_trace typ lifecycle_typ lifecycle_procs proc_file_map tenv = match typ with
| Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some name } -> | Sil.Tstruct { Sil.csu = Csu.Class Csu.Java; struct_name = Some name } ->
let class_name = Typename.TN_csu (Csu.Class, name) in let class_name = Typename.TN_csu (Csu.Class Csu.Java, name) in
if AndroidFramework.typ_is_lifecycle_typ typ lifecycle_typ tenv && if AndroidFramework.typ_is_lifecycle_typ typ lifecycle_typ tenv &&
not (AndroidFramework.is_android_lib_class class_name) then not (AndroidFramework.is_android_lib_class class_name) then
let ptr_to_typ = Some (Sil.Tptr (typ, Sil.Pk_pointer)) in let ptr_to_typ = Some (Sil.Tptr (typ, Sil.Pk_pointer)) in
@ -146,7 +146,7 @@ let extract_callbacks lifecycle_trace harness_procname proc_file_map tenv =
Sil.Tstruct { Sil.Tstruct {
Sil.instance_fields = fields; Sil.instance_fields = fields;
static_fields = []; static_fields = [];
csu = Csu.Class; csu = Csu.Class Csu.Java;
struct_name = Some harness_name; struct_name = Some harness_name;
superclasses = []; superclasses = [];
def_methods = [harness_procname]; def_methods = [harness_procname];
@ -154,7 +154,7 @@ let extract_callbacks lifecycle_trace harness_procname proc_file_map tenv =
} in } 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 = Typename.TN_csu (Csu.Class, harness_name) in let harness_class = Typename.TN_csu (Csu.Class Csu.Java, 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) ->

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

@ -108,7 +108,7 @@ let rec inhabit_typ typ proc_file_map env =
(* select methods that are constructors and won't force us into infinite recursion because (* select methods that are constructors and won't force us into infinite recursion because
* we are already inhabiting one of their argument types *) * we are already inhabiting one of their argument types *)
let get_all_suitable_constructors typ = match typ with let get_all_suitable_constructors typ = match typ with
| Sil.Tstruct { Sil.csu = Csu.Class; def_methods } -> | Sil.Tstruct { Sil.csu = Csu.Class _; def_methods } ->
let is_suitable_constructor p = let is_suitable_constructor p =
let try_get_non_receiver_formals p = let try_get_non_receiver_formals p =
try get_non_receiver_formals (formals_from_name p proc_file_map) try get_non_receiver_formals (formals_from_name p proc_file_map)
@ -205,7 +205,7 @@ let inhabit_fld_trace flds proc_file_map env =
Sil.Letderef (lhs, fld_exp, fld_typ, env.pc) in Sil.Letderef (lhs, fld_exp, fld_typ, env.pc) in
let env = env_add_instr fld_read_instr [lhs] env in let env = env_add_instr fld_read_instr [lhs] env in
match fld_typ with match fld_typ with
| Sil.Tptr (Sil.Tstruct { Sil.csu = Csu.Class; def_methods }, _) -> | Sil.Tptr (Sil.Tstruct { Sil.csu = Csu.Class _; def_methods }, _) ->
let inhabit_cb_call procname env = let inhabit_cb_call procname env =
try try
let procdesc = procdesc_from_name procname proc_file_map in let procdesc = procdesc_from_name procname proc_file_map in

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

@ -42,8 +42,8 @@ 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 (Typename.TN_csu (Csu.Class, class_name)) with match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, class_name)) with
| Some Sil.Tstruct { Sil.csu = Csu.Class; def_methods } -> | Some Sil.Tstruct { Sil.csu = Csu.Class _; def_methods } ->
let possible_calls = let possible_calls =
IList.filter IList.filter
(fun proc -> Procname.java_get_method proc = str_frame.method_str) (fun proc -> Procname.java_get_method proc = str_frame.method_str)

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

@ -107,7 +107,7 @@ let retrieve_fieldname fieldname =
let get_field_name program static tenv cn fs context = let get_field_name program static tenv cn fs context =
match JTransType.get_class_type_no_pointer program tenv cn with match JTransType.get_class_type_no_pointer program tenv cn with
| Sil.Tstruct { Sil.instance_fields; static_fields; csu = Csu.Class } -> | Sil.Tstruct { Sil.instance_fields; static_fields; csu = Csu.Class _ } ->
let fieldname, _, _ = let fieldname, _, _ =
try try
IList.find IList.find

10
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 =
Typename.TN_csu (Csu.Class, (Mangled.from_string (JBasics.cn_name cn))) Typename.TN_csu (Csu.Class Csu.Java, (Mangled.from_string (JBasics.cn_name cn)))
let rec get_named_type vt = let rec get_named_type vt =
@ -91,7 +91,7 @@ let rec create_array_type typ dim =
let extract_cn_no_obj typ = let extract_cn_no_obj typ =
match typ with match typ with
| Sil.Tptr (Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some classname }, | Sil.Tptr (Sil.Tstruct { Sil.csu = Csu.Class _; struct_name = Some classname },
Sil.Pk_pointer) -> Sil.Pk_pointer) ->
let class_name = (Mangled.to_string classname) in let class_name = (Mangled.to_string classname) in
if class_name = JConfig.object_cl then None if class_name = JConfig.object_cl then None
@ -243,7 +243,7 @@ let dummy_type cn =
Sil.Tstruct { Sil.Tstruct {
Sil.instance_fields = []; Sil.instance_fields = [];
static_fields = []; static_fields = [];
csu = Csu.Class; csu = Csu.Class Csu.Java;
struct_name = Some classname; struct_name = Some classname;
superclasses = []; superclasses = [];
def_methods = []; def_methods = [];
@ -336,7 +336,7 @@ and create_sil_type program tenv cn =
let super_classname = let super_classname =
match get_class_type_no_pointer program tenv super_cn with match get_class_type_no_pointer program tenv super_cn with
| Sil.Tstruct { Sil.struct_name = Some classname } -> | Sil.Tstruct { Sil.struct_name = Some classname } ->
Typename.TN_csu (Csu.Class, classname) Typename.TN_csu (Csu.Class Csu.Java, classname)
| _ -> assert false in | _ -> assert false in
super_classname :: interface_list in super_classname :: interface_list in
(super_classname_list, nonstatic_fields, static_fields, item_annotation) in (super_classname_list, nonstatic_fields, static_fields, item_annotation) in
@ -345,7 +345,7 @@ and create_sil_type program tenv cn =
Sil.Tstruct { Sil.Tstruct {
Sil.instance_fields; Sil.instance_fields;
static_fields; static_fields;
csu = Csu.Class; csu = Csu.Class Csu.Java;
struct_name = Some classname; struct_name = Some classname;
superclasses; superclasses;
def_methods; def_methods;

Write Preview
Loading…
Cancel
Save