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,
And Objective C protocol *)
type class_kind =
| CPP
| Java
| Objc
type t =
| Class
| Class of class_kind
| Struct
| Union
| Protocol
let name = function
| Class -> "class"
| Class _ -> "class"
| Struct -> "struct"
| Union -> "union"
| 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 =
match dstruct1, dstruct2 with
| Class, Class -> 0
| Class, _ -> -1
| _, Class -> 1
| Class ck1, Class ck2 -> class_kind_compare ck1 ck2
| Class _, _ -> -1
| _, Class _ -> 1
| Struct, Struct -> 0
| Struct, _ -> -1
| _, Struct -> 1

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

@ -11,8 +11,13 @@
C-style structs struct and union,
And Objective C protocol *)
type class_kind =
| CPP
| Java
| Objc
type t =
| Class
| Class of class_kind
| Struct
| Union
| 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 =
match hpred_type_opt with
| Some (Sil.Sizeof (Sil.Tstruct
{ Sil.csu = Csu.Class;
{ Sil.csu = Csu.Class _;
Sil.struct_name = Some classname;
}, _))
when !Config.curr_language = Config.Java ->
}, _)) ->
" of type " ^ Mangled.to_string classname ^ " "
| _ -> " " in
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 =
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.def_methods = 0)
| _ -> false
@ -1464,7 +1464,7 @@ let check_subclass_tenv tenv c1 c2 =
let rec check cn =
Typename.equal cn c2 || Typename.equal c2 object_type ||
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
| _ -> false in
check c1
@ -1485,10 +1485,10 @@ let check_subtype_basic_type t1 t2 =
(** check if t1 is a subtype of t2 *)
let rec check_subtype tenv t1 t2 =
match t1, t2 with
| Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some c1 },
Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some c2 } ->
let cn1 = Typename.TN_csu (Csu.Class, c1)
and cn2 = Typename.TN_csu (Csu.Class, c2) in
| Sil.Tstruct { Sil.csu = Csu.Class ck1; struct_name = Some c1 },
Sil.Tstruct { Sil.csu = Csu.Class ck2; struct_name = Some c2 } ->
let cn1 = Typename.TN_csu (Csu.Class ck1, c1)
and cn2 = Typename.TN_csu (Csu.Class ck2, c2) in
(check_subclass tenv cn1 cn2)
| 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, _) ->
check_subtype tenv dom_type1 dom_type2
| Sil.Tarray _, Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some c2 } ->
let cn2 = Typename.TN_csu (Csu.Class, c2) in
| Sil.Tarray _, Sil.Tstruct { Sil.csu = Csu.Class ck2; struct_name = Some c2 } ->
let cn2 = Typename.TN_csu (Csu.Class ck2, c2) in
Typename.equal cn2 serializable_type
|| Typename.equal cn2 cloneable_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) =
match t1, t2 with
| Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some c1 },
Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some c2 } ->
let cn1 = Typename.TN_csu (Csu.Class, c1)
and cn2 = Typename.TN_csu (Csu.Class, c2) in
| Sil.Tstruct { Sil.csu = Csu.Class ck1; struct_name = Some c1 },
Sil.Tstruct { Sil.csu = Csu.Class ck2; struct_name = Some c2 } ->
let cn1 = Typename.TN_csu (Csu.Class ck1, c1)
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.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, _) ->
(case_analysis_type tenv (dom_type1, st1) (dom_type2, st2))
| Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some c1 }, Sil.Tarray _ ->
let cn1 = Typename.TN_csu (Csu.Class, c1) in
| Sil.Tstruct { Sil.csu = Csu.Class ck1; struct_name = Some c1 }, Sil.Tarray _ ->
let cn1 = Typename.TN_csu (Csu.Class ck1, c1) in
if (Typename.equal cn1 serializable_type
|| Typename.equal cn1 cloneable_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.Java ->
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
| Some typ -> typ
| 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 *)
Sil.Estruct ([(Ident.create_fieldname (Mangled.from_string "java.lang.Class.name") 0, Sil.Eexp ((Sil.Const (Sil.Cstr s), Sil.Inone)))], Sil.inst_none) in
let class_texp =
let class_type = 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
| Some typ -> typ
| 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 =
class_annotation cpp_class_str
let is_class_of_language typ class_string =
let is_class_of_kind typ ck =
match typ with
| Tstruct { csu = Csu.Class; struct_annotations } ->
(match struct_annotations with
| [({ class_name = n; parameters = []}, true)]
when n = class_string -> true
| _ -> false)
| _ -> false
| Tstruct { csu = Csu.Class ck' } ->
ck = ck'
| _ ->
false
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 =
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 *)
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_java_class : typ -> bool
val exp_is_zero : 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)
else Procname.c_method_replace_class proc_name (Typename.name class_name) in
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
Some right_proc_name
else
@ -635,8 +635,8 @@ let resolve_typename prop arg =
loop (Prop.get_sigma prop) in
match typexp_opt with
| Some (Sil.Sizeof (Sil.Tstruct { Sil.struct_name = None }, _)) -> None
| Some (Sil.Sizeof (Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some name }, _)) ->
Some (Typename.TN_csu (Csu.Class, name))
| Some (Sil.Sizeof (Sil.Tstruct { Sil.csu = Csu.Class ck; struct_name = Some name }, _)) ->
Some (Typename.TN_csu (Csu.Class ck, name))
| _ -> None
(** 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 class_shared_ptr typ =
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
name = "shared_ptr" || name = "__shared_ptr"
| 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)
| typ_str ->
(* 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
| Some (Sil.Tstruct _ as typ) -> typ
| _ -> 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 *)
let lhs_normal = Prop.exp_normalize_prop _prop lhs in
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"
| _ -> false in
let lhs_is_ns_ptr () =
@ -2508,7 +2508,8 @@ module ModelBuiltins = struct
sym_exec_generated false cfg tenv pdesc [alloc_instr] symb_state
let execute_objc_NSArray_alloc_no_fail cfg pdesc tenv symb_state ret_ids loc =
let nsarray_typ = Sil.Tvar (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
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 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 =
Sil.expand_type tenv nsdictionary_typ in
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
| Sil.Hpointsto (e1, _, Sil.Sizeof (Sil.Tstruct { Sil.struct_name = Some name }, _))
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
| _ -> () 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 =
match typ with
| Sil.Tptr (typ , _) -> type_to_string typ
| Sil.Tstruct { Sil.csu = Csu.Class; struct_name = Some mangled }
| Sil.Tvar (Typename.TN_csu (Csu.Class, mangled)) -> Mangled.to_string mangled
| Sil.Tstruct { Sil.csu = Csu.Class _; struct_name = Some mangled }
| Sil.Tvar (Typename.TN_csu (Csu.Class _, mangled)) -> Mangled.to_string mangled
| _ -> Sil.typ_to_string typ
let string_typ_to_string (s, typ) =
@ -311,7 +311,7 @@ let initial_node = ref (Cfg.Node.dummy ())
let rec super tenv t =
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.Tarray (dom_type, _) -> None
| Sil.Tptr (dom_type, p) ->
@ -412,7 +412,8 @@ struct
| Sil.Cfun fn -> assert false
| Sil.Cstr str ->
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.Cattribute atr -> assert false
| Sil.Cexn e -> assert false

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

@ -48,7 +48,7 @@ module Java =
struct
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

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 *)
let callback_checker_main all_procs get_procdesc idenv tenv proc_name proc_desc =
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
| Some (Sil.Tstruct { Sil.csu; struct_name = Some class_name; def_methods } as typ) ->
let lifecycle_typs = get_or_create_lifecycle_typs tenv in

23
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 expr_match () = Sil.exp_is_this this_expr in
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
method_match () && expr_match () && type_match () in
@ -374,16 +375,16 @@ let callback_find_deserialization all_procs get_proc_desc idenv tenv proc_name p
try
ST.pname_find proc_name' ret_const_key
with Not_found ->
match get_proc_desc proc_name' with
Some proc_desc' ->
let is_return_instr = function
| Sil.Set (Sil.Lvar p, _, _, _)
when Sil.pvar_equal p (Cfg.Procdesc.get_ret_var proc_desc') -> true
| _ -> false in
(match reverse_find_instr is_return_instr (Cfg.Procdesc.get_exit_node proc_desc') with
| Some (Sil.Set (_, _, Sil.Const (Sil.Cclass n), _)) -> Ident.name_to_string n
| _ -> "<" ^ (Procname.to_string proc_name') ^ ">")
| None -> "?" in
match get_proc_desc proc_name' with
Some proc_desc' ->
let is_return_instr = function
| Sil.Set (Sil.Lvar p, _, _, _)
when Sil.pvar_equal p (Cfg.Procdesc.get_ret_var proc_desc') -> true
| _ -> false in
(match reverse_find_instr is_return_instr (Cfg.Procdesc.get_exit_node proc_desc') with
| Some (Sil.Set (_, _, Sil.Const (Sil.Cclass n), _)) -> Ident.name_to_string n
| _ -> "<" ^ (Procname.to_string proc_name') ^ ">")
| None -> "?" in
let get_actual_arguments node instr = match instr with
| Sil.Call (ret_ids, Sil.Const (Sil.Cfun pn), (te, tt):: args, loc, cf) ->

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
| Sil.Tptr (Sil.Tstruct { Sil.struct_name = 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
| _ -> None
@ -229,7 +229,7 @@ let type_is_class = function
let initializer_classes =
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.Application";
@ -322,7 +322,7 @@ let proc_iter_overridden_methods f tenv proc_name =
if Procname.is_java proc_name then
let type_name =
let class_name = Procname.java_get_class proc_name in
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
| Some 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
let classname =
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
| Some typ ->
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
| ContextNoCls -> Hashtbl.hash "no class"
let create_curr_class tenv class_name =
let class_tn_name = Typename.TN_csu (Csu.Class, (Mangled.from_string class_name)) in
let create_curr_class tenv class_name ck =
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
| Some Sil.Tstruct { Sil.superclasses } ->
(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 ->
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

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 _ -> []
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
| Some dr ->
(match dr.Clang_ast_t.dr_name with
| 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
| _ -> [])
| _ -> []
@ -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 *)
(* 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 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
| Some Sil.Tstruct ({ Sil.instance_fields } as struct_typ) ->
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
Sil.instance_fields = new_fields;
static_fields = [];
csu = Csu.Class;
csu = Csu.Class ck;
struct_name = Some mang_name;
} in
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 field_name, typ, attr = build_sil_field type_ptr_to_sil_type tenv
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)
| _ -> 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 *)
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
val get_fields : Ast_utils.type_ptr_to_sil_type -> Sil.tenv -> CContext.curr_class ->
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 ->
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

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

@ -40,7 +40,7 @@ let direct_atomic_property_access context stmt_info ivar_name =
General_utils.mk_class_field_name n,
Ast_utils.get_class_name_from_member n
| _ -> Ident.create_fieldname (Mangled.from_string "") 0, "" in
let tname = 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
match Sil.tenv_lookup tenv tname with
| 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 =
Sil.tenv_iter (fun typname typ ->
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
| Sil.Tstruct { Sil.instance_fields; superclasses; def_methods; struct_annotations } ->
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 -> None
let get_superclass_curr_class context =
let get_superclass_curr_class_objc context =
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);
match Sil.tenv_lookup (CContext.get_tenv context) iname with
| 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, t):: _ -> CTypes.classname_of_type t
| _ -> assert false)
| `SuperInstance ->get_superclass_curr_class context
| `SuperClass -> get_superclass_curr_class context
| `SuperInstance ->get_superclass_curr_class_objc context
| `SuperClass -> get_superclass_curr_class_objc context
let get_objc_method_data obj_c_message_expr_info =
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
{ Sil.instance_fields = fields;
static_fields = [];
csu = Csu.Class;
csu = Csu.Class Csu.Objc;
struct_name = Some mblock;
superclasses = [];
def_methods = [];
struct_annotations = [];
} 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;
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
@ -430,7 +430,7 @@ struct
raise (Self.SelfClassException (CContext.get_curr_class_name curr_class))
else
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)]
else [(e, typ)] in
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
match receiver_kind with
| `Class type_ptr ->
let class_opt = CMethod_trans.get_class_name_method_call_from_clang context.tenv
obj_c_message_expr_info in
let class_opt =
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)
| _ -> None
(* assertions *)
@ -1568,13 +1569,17 @@ struct
(* variable might be initialized already - do nothing in that case*)
if IList.exists (Sil.exp_equal var_exp) res_trans_ie.initd_exps then ([], [], [])
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 *)
(* we need to add retain/release *)
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)
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
ids = ids_assign;
instrs = instrs_assign } in

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

@ -535,7 +535,8 @@ struct
if is_superinstance mei then
let typ, self_expr, id, ins =
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 id = Ident.create_fresh Ident.knormal 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 ->
let sil_typ = type_ptr_to_sil_type translate_decl tenv typ in
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)
| `DeclPtr ptr -> decl_ptr_to_sil_type translate_decl tenv ptr
| `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;
!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)

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 mk_classname : string -> Typename.t
val mk_classname : string -> Csu.class_kind -> 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 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 =
Sil.Tstruct {
Sil.instance_fields = [];
@ -65,7 +65,7 @@ let add_predefined_basic_types tenv =
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_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
add_basic_type create_int_type `Int;
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
match buf with
| "struct":: l ->Csu.Struct
| "class":: l -> Csu.Class
| "class":: l -> Csu.Class Csu.CPP
| "union":: l -> Csu.Union
| _ -> Csu.Struct)
| _ -> assert false
@ -107,7 +107,7 @@ let get_record_name_csu decl =
name_info, opt_type, not cxx_record_info.xrdi_is_c_like
| _-> assert false 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
csu', name
@ -140,10 +140,11 @@ let get_superclass_decls decl =
| _ -> []
(** 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 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
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 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 superclasses = get_superclass_list decl in
let superclasses = get_superclass_list_cpp decl in
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 *)
let sil_type = Sil.Tstruct
{ 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
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 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

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

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 class_name = CContext.get_curr_class_name curr_class 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
Ast_utils.update_sil_types_map decl_key (Sil.Tvar class_tn_name);
(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.instance_fields = new_fields;
static_fields = [];
csu = Csu.Class;
csu = Csu.Class Csu.Objc;
struct_name = Some mang_name;
def_methods = new_methods;
} 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 =
match typ with
| Sil.Tptr (Sil.Tvar (Typename.TN_csu (Csu.Class, cname)), _) ->
(match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class, cname)) with
| Sil.Tptr (Sil.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, cname)), _) ->
(match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Objc, cname)) with
| Some typ when Sil.is_objc_class typ -> true
| _ -> false)
| Sil.Tptr (typ, _) when Sil.is_objc_class typ -> true
@ -81,7 +81,7 @@ let get_interface_superclasses super_opt protocols =
let super_class =
match super_opt with
| 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 (
fun name -> Typename.TN_csu (Csu.Protocol, Mangled.from_string name)
) 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. *)
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;
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
Ast_utils.update_sil_types_map decl_key (Sil.Tvar interface_name);
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_protocols 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, _) ->
Printing.log_out "----->SuperClass field: '%s' " (Ident.fieldname_to_string fn);
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.instance_fields = fields;
static_fields = [];
csu = Csu.Class;
csu = Csu.Class Csu.Objc;
struct_name = Some (Mangled.from_string class_name);
superclasses;
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");
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 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
Ast_utils.update_sil_types_map decl_key (Sil.Tvar class_tn_name);
(match Sil.tenv_lookup tenv class_tn_name with
| Some Sil.Tstruct
({ Sil.static_fields = [];
csu = Csu.Class;
csu = Csu.Class ck;
struct_name = Some name;
def_methods;
} 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 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
CField_decl.add_missing_fields tenv class_name fields;
let typ = add_missing_methods tenv class_name decl_info decl_list curr_class in
CField_decl.add_missing_fields tenv class_name Csu.Objc fields;
let typ = add_missing_methods tenv class_name Csu.Objc decl_info decl_list curr_class in
typ
| _ -> 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_class = Mangled.from_string "java.lang.Throwable" in
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
| _ -> false in
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 *)
let get_all_supertypes typ tenv =
let get_direct_supers = function
| Sil.Tstruct { Sil.csu = Csu.Class; superclasses } ->
| Sil.Tstruct { Sil.csu = Csu.Class _; superclasses } ->
superclasses
| _ -> [] in
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 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
| _ -> 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 supertyps = get_all_supertypes typ tenv in
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
| _ -> 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
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 =
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
{ 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 *)
let lookup_proc lifecycle_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
lifecycle trace *)
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 } ->
let class_name = Typename.TN_csu (Csu.Class, name) in
| Sil.Tstruct { Sil.csu = Csu.Class Csu.Java; struct_name = Some name } ->
let class_name = Typename.TN_csu (Csu.Class Csu.Java, name) in
if AndroidFramework.typ_is_lifecycle_typ typ lifecycle_typ tenv &&
not (AndroidFramework.is_android_lib_class class_name) then
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.instance_fields = fields;
static_fields = [];
csu = Csu.Class;
csu = Csu.Class Csu.Java;
struct_name = Some harness_name;
superclasses = [];
def_methods = [harness_procname];
@ -154,7 +154,7 @@ let extract_callbacks lifecycle_trace harness_procname proc_file_map tenv =
} in
(* update the tenv with our created harness typ. we don't have to save the tenv to disk here
* because this is done immediately after harness generation runs in jMain.ml *)
let harness_class = 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;
let cfgs_to_save =
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
* we are already inhabiting one of their argument types *)
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 try_get_non_receiver_formals p =
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
let env = env_add_instr fld_read_instr [lhs] env in
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 =
try
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
* in the stack trace. Note that the stack trace does not have any type or argument information;
* the name is all that we have to go on *)
match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class, class_name)) with
| Some Sil.Tstruct { Sil.csu = Csu.Class; def_methods } ->
match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, class_name)) with
| Some Sil.Tstruct { Sil.csu = Csu.Class _; def_methods } ->
let possible_calls =
IList.filter
(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 =
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, _, _ =
try
IList.find

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

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

Write Preview
Loading…
Cancel
Save