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

Replace optional mangled struct_name with typename

Browse Source 
Summary: Replace the struct_name: Mangled.t option field of Typ.struct_typ with name: Typename.t

Reviewed By: sblackshear

Differential Revision: D3791860

fbshipit-source-id: 3ee1d00
master
Josh Berdine 8 years ago committed by Facebook Github Bot 7
parent 90314a4d94
commit f0940f25d7
30 changed files with 136 additions and 199 deletions
Show Stats Download Patch File Download Diff File

18
infer/src/IR/AttributesTable.re
Unescape View File

@ -79,8 +79,8 @@ let load_attributes proc_name =>
};
/** Given a procdesure name, find the file where it is defined and */
/** its corresponding type environment */
/** Given a procedure name, find the file where it is defined and its corresponding type
environment */
let find_tenv_from_class_of_proc procname =>
switch (load_attributes procname) {
| None => None
@ -92,16 +92,14 @@ let find_tenv_from_class_of_proc procname =>
};
/** Given an ObjC class c, extract the type from the tenv where the class was */
/** defined. We do this by adding a method that is unique to each class, and then */
/** finding the tenv that corresponds to the class definition. */
let get_correct_type_from_objc_class_name c => {
let class_method = Procname.get_default_objc_class_method (Mangled.to_string c);
/** Given the name of an ObjC class, extract the type from the tenv where the class was defined. We
do this by adding a method that is unique to each class, and then finding the tenv that
corresponds to the class definition. */
let get_correct_type_from_objc_class_name type_name => {
let class_method = Procname.get_default_objc_class_method (Typename.name type_name);
switch (find_tenv_from_class_of_proc class_method) {
| None => None
| Some tenv =>
let type_name = Typename.TN_csu (Csu.Class Csu.Objc) c;
Option.map (fun st => Typ.Tstruct st) (Tenv.lookup tenv type_name)
| Some tenv => Option.map (fun st => Typ.Tstruct st) (Tenv.lookup tenv type_name)
}
};

12
infer/src/IR/AttributesTable.rei
Unescape View File

@ -22,15 +22,15 @@ let store_attributes: ProcAttributes.t => unit;
let load_attributes: Procname.t => option ProcAttributes.t;
/** Given a procdesure name, find the file where it is defined and */
/** its corresponding type environment */
/** Given a procedure name, find the file where it is defined and its corresponding type
environment */
let find_tenv_from_class_of_proc: Procname.t => option Tenv.t;
/** Given an ObjC class c, extract the type from the tenv where the class was */
/** defined. We do this by adding a method that is unique to each class, and then */
/** finding the tenv that corresponds to the class definition. */
let get_correct_type_from_objc_class_name: Mangled.t => option Typ.t;
/** Given the name of an ObjC class, extract the type from the tenv where the class was defined. We
do this by adding a method that is unique to each class, and then finding the tenv that
corresponds to the class definition. */
let get_correct_type_from_objc_class_name: Typename.t => option Typ.t;
/** Returns true if the method is defined as a C++ model */

3
infer/src/IR/Cfg.re
Unescape View File

@ -659,8 +659,7 @@ let module Node = {
| exp => exp;
let extract_class_name =
fun
| Typ.Tptr (Typ.Tstruct {Typ.struct_name: struct_name}) _ when struct_name != None =>
Mangled.to_string (Option.get struct_name)
| Typ.Tptr (Tstruct {name}) _ => Typename.name name
| _ => failwith "Expecting classname for Java types";
let subst_map = ref Ident.IdentMap.empty;
let redirected_class_name origin_id =>

46
infer/src/IR/Typ.re
Unescape View File

@ -283,10 +283,10 @@ type static_length = option IntLit.t;
type struct_fields = list (Ident.fieldname, t, item_annotation)
/** Type for a structured value. */
and struct_typ = {
name: Typename.t, /** name */
instance_fields: struct_fields, /** non-static fields */
static_fields: struct_fields, /** static fields */
csu: Csu.t, /** class/struct/union */
struct_name: option Mangled.t, /** name */
superclasses: list Typename.t, /** list of superclasses */
def_methods: list Procname.t, /** methods defined */
struct_annotations: item_annotation /** annotations */
@ -302,20 +302,12 @@ and t =
| Tstruct of struct_typ /** Type for a structured value */
| Tarray of t static_length /** array type with statically fixed length */;
let cname_opt_compare nameo1 nameo2 =>
switch (nameo1, nameo2) {
| (None, None) => 0
| (None, _) => (-1)
| (_, None) => 1
| (Some n1, Some n2) => Mangled.compare n1 n2
};
let rec fld_typ_ann_compare fta1 fta2 =>
triple_compare Ident.fieldname_compare compare item_annotation_compare fta1 fta2
and fld_typ_ann_list_compare ftal1 ftal2 => IList.compare fld_typ_ann_compare ftal1 ftal2
and struct_typ_compare struct_typ1 struct_typ2 =>
if (struct_typ1.csu == Csu.Class Csu.Java && struct_typ2.csu == Csu.Class Csu.Java) {
cname_opt_compare struct_typ1.struct_name struct_typ2.struct_name
Typename.compare struct_typ1.name struct_typ2.name
} else {
let n = fld_typ_ann_list_compare struct_typ1.instance_fields struct_typ2.instance_fields;
if (n != 0) {
@ -329,7 +321,7 @@ and struct_typ_compare struct_typ1 struct_typ2 =>
if (n != 0) {
n
} else {
cname_opt_compare struct_typ1.struct_name struct_typ2.struct_name
Typename.compare struct_typ1.name struct_typ2.name
}
}
}
@ -375,30 +367,21 @@ let struct_typ_equal struct_typ1 struct_typ2 => struct_typ_compare struct_typ1 s
let equal t1 t2 => compare t1 t2 == 0;
let rec pp_struct_typ pe pp_base f struct_typ =>
switch struct_typ.struct_name {
| Some name when false =>
/* remove "when false" to print the details of struct */
let rec pp_struct_typ pe pp_base f {csu, instance_fields, name} =>
if false {
/* change false to true to print the details of struct */
F.fprintf
f
"%s %a {%a} %a"
(Csu.name struct_typ.csu)
Mangled.pp
(Csu.name csu)
Typename.pp
name
(pp_seq (fun f (fld, t, _) => F.fprintf f "%a %a" (pp_full pe) t Ident.pp_fieldname fld))
struct_typ.instance_fields
pp_base
()
| Some name => F.fprintf f "%s %a %a" (Csu.name struct_typ.csu) Mangled.pp name pp_base ()
| None =>
F.fprintf
f
"%s {%a} %a"
(Csu.name struct_typ.csu)
(pp_seq (fun f (fld, t, _) => F.fprintf f "%a %a" (pp_full pe) t Ident.pp_fieldname fld))
struct_typ.instance_fields
instance_fields
pp_base
()
} else {
F.fprintf f "%a %a" Typename.pp name pp_base ()
}
/** Pretty print a type declaration.
pp_base prints the variable for a declaration, or can be skip to print only the type */
@ -474,6 +457,13 @@ let module Tbl = Hashtbl.Make {
let hash = Hashtbl.hash;
};
let name t =>
switch t {
| Tvar name
| Tstruct {name} => Some name
| _ => None
};
let unsome s =>
fun
| Some default_typ => default_typ

6
infer/src/IR/Typ.rei
Unescape View File

@ -138,10 +138,10 @@ type static_length = option IntLit.t;
type struct_fields = list (Ident.fieldname, t, item_annotation)
/** Type for a structured value. */
and struct_typ = {
name: Typename.t, /** name */
instance_fields: struct_fields, /** non-static fields */
static_fields: struct_fields, /** static fields */
csu: Csu.t, /** class/struct/union */
struct_name: option Mangled.t, /** name */
superclasses: list Typename.t, /** list of superclasses */
def_methods: list Procname.t, /** methods defined */
struct_annotations: item_annotation /** annotations */
@ -210,6 +210,10 @@ let module Map: Map.S with type key = t;
let module Tbl: Hashtbl.S with type key = t;
/** The name of a type */
let name: t => option Typename.t;
/** turn a *T into a T. fails if [t] is not a pointer type */
let strip_ptr: t => t;

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

@ -247,10 +247,9 @@ let by_call_to_ra tags ra =
let rec format_typ = function
| Typ.Tptr (typ, _) when !Config.curr_language = Config.Java ->
format_typ typ
| Typ.Tstruct { Typ.struct_name = Some name } ->
Mangled.to_string name
| Typ.Tvar tname ->
Typename.name tname
| Typ.Tstruct { name }
| Typ.Tvar name ->
Typename.name name
| typ ->
Typ.to_string typ
@ -686,11 +685,8 @@ let desc_leak hpred_type_opt value_str_opt resource_opt resource_action_opt loc
s, " to ", " on " in
let typ_str =
match hpred_type_opt with
| Some (Exp.Sizeof (Typ.Tstruct
{ Typ.csu = Csu.Class _;
Typ.struct_name = Some classname;
}, _, _)) ->
" of type " ^ Mangled.to_string classname ^ " "
| Some (Exp.Sizeof (Tstruct { csu = Class _; name; }, _, _)) ->
" of type " ^ Typename.name name ^ " "
| _ -> " " in
let desc_str =
match resource_opt with

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

@ -760,11 +760,9 @@ let execute_alloc mk can_return_null
evaluate_char_sizeof (Exp.Const (Const.Cint len))
| Exp.Sizeof _ -> e in
let size_exp, procname = match args with
| [(Exp.Sizeof
(Typ.Tstruct
{ Typ.csu = Csu.Class Csu.Objc; struct_name = Some c } as s, len, subt), _)] ->
| [(Exp.Sizeof (Tstruct { csu = Class Objc; name } as s, len, subt), _)] ->
let struct_type =
match AttributesTable.get_correct_type_from_objc_class_name c with
match AttributesTable.get_correct_type_from_objc_class_name name with
| Some struct_type -> struct_type
| None -> s in
Exp.Sizeof (struct_type, len, subt), pname

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

@ -208,10 +208,10 @@ struct
match typ with
| Typ.Tptr (styp, _ ) ->
is_core_lib lib styp
| Typ.Tvar (Typename.TN_csu (_, name) )
| Typ.Tstruct { Typ.struct_name = Some name } ->
| Typ.Tvar name
| Typ.Tstruct { name } ->
let core_lib_types = core_lib_to_type_list lib in
IList.mem (=) (Mangled.to_string name) core_lib_types
IList.mem string_equal (Typename.name name) core_lib_types
| _ -> false
let is_core_foundation_type typ =

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

@ -1464,25 +1464,28 @@ let move_primed_lhs_from_front subs sigma = match sigma with
Return [(changed, calc_index_frame', hpred')] where [changed] indicates whether the predicate has changed. *)
let expand_hpred_pointer calc_index_frame hpred : bool * bool * Sil.hpred =
let rec expand changed calc_index_frame hpred = match hpred with
| Sil.Hpointsto (Exp.Lfield (e, fld, typ_fld), se, t) ->
let t' = match t, typ_fld with
| _, Typ.Tstruct _ -> (* the struct type of fld is known *)
Exp.Sizeof (typ_fld, None, Subtype.exact)
| Exp.Sizeof (t1, len, st), _ ->
(* the struct type of fld is not known -- typically Tvoid *)
| Sil.Hpointsto (Lfield (adr_base, fld, adr_typ), cnt, cnt_texp) ->
let cnt_texp' = match adr_typ, cnt_texp with
| Tstruct _, _ ->
(* type of struct at adr_base is known *)
Exp.Sizeof (adr_typ, None, Subtype.exact)
| _, Sizeof (cnt_typ, len, st) ->
(* type of struct at adr_base is unknown (typically Tvoid), but
type of contents is known, so construct struct type for single fld:cnt_typ *)
Exp.Sizeof
(Typ.Tstruct
{ Typ.instance_fields = [(fld, t1, Typ.item_annotation_empty)];
(Tstruct
{ instance_fields = [(fld, cnt_typ, Typ.item_annotation_empty)];
static_fields = [];
csu = Csu.Struct;
struct_name = None;
Typ.superclasses = [];
Typ.def_methods = [];
Typ.struct_annotations = Typ.item_annotation_empty;
csu = Struct;
name = TN_csu (Struct, Mangled.from_string "counterfeit");
superclasses = [];
def_methods = [];
struct_annotations = Typ.item_annotation_empty;
}, len, st)
(* None as we don't know the stuct name *)
| _ -> raise (Failure "expand_hpred_pointer: Unexpected non-sizeof type in Lfield") in
let hpred' = Sil.Hpointsto (e, Sil.Estruct ([(fld, se)], Sil.inst_none), t') in
| _ ->
(* type of struct at adr_base and of contents are both unknown: give up *)
raise (Failure "expand_hpred_pointer: Unexpected non-sizeof type in Lfield") in
let hpred' = Sil.Hpointsto (adr_base, Estruct ([(fld, cnt)], Sil.inst_none), cnt_texp') in
expand true true hpred'
| Sil.Hpointsto (Exp.Lindex (e, ind), se, t) ->
let t' = match t with
@ -1505,7 +1508,7 @@ let expand_hpred_pointer calc_index_frame hpred : bool * bool * Sil.hpred =
module Subtyping_check =
struct
let object_type = Typename.Java.from_string "java.lang.Object"
let object_type = Typename.Java.from_string JConfig.object_cl
let serializable_type = Typename.Java.from_string "java.io.Serializable"
@ -1513,7 +1516,7 @@ struct
let is_interface tenv class_name =
match Tenv.lookup tenv class_name with
| Some ({ Typ.csu = Csu.Class Csu.Java; struct_name = Some _ } as struct_typ) ->
| Some ({ csu = Class Java } as struct_typ) ->
(IList.length struct_typ.Typ.instance_fields = 0) &&
(IList.length struct_typ.Typ.def_methods = 0)
| _ -> false
@ -1531,7 +1534,7 @@ struct
let rec check cn =
Typename.equal cn c2 || is_root_class c2 ||
match Tenv.lookup tenv cn with
| Some ({ Typ.struct_name = Some _; csu = Csu.Class _; superclasses }) ->
| Some ({ csu = Class _; superclasses }) ->
IList.exists check superclasses
| _ -> false in
check c1
@ -1552,10 +1555,7 @@ struct
(** check if t1 is a subtype of t2, in Java *)
let rec check_subtype_java tenv t1 t2 =
match t1, t2 with
| Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; struct_name = Some c1 },
Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; struct_name = Some c2 } ->
let cn1 = Typename.TN_csu (Csu.Class Csu.Java, c1)
and cn2 = Typename.TN_csu (Csu.Class Csu.Java, c2) in
| Typ.Tstruct { csu = Class Java; name = cn1 }, Typ.Tstruct { csu = Class Java; name = cn2 } ->
check_subclass tenv cn1 cn2
| Typ.Tarray (dom_type1, _), Typ.Tarray (dom_type2, _) ->
@ -1564,18 +1564,15 @@ struct
| Typ.Tptr (dom_type1, _), Typ.Tptr (dom_type2, _) ->
check_subtype_java tenv dom_type1 dom_type2
| Typ.Tarray _, Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; struct_name = Some c2 } ->
let cn2 = Typename.TN_csu (Csu.Class Csu.Java, c2) in
| Typ.Tarray _, Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; name = cn2 } ->
Typename.equal cn2 serializable_type
|| Typename.equal cn2 cloneable_type
|| Typename.equal cn2 object_type
| _ -> check_subtype_basic_type t1 t2
let get_cpp_objc_type_name t =
let get_type_name (t: Typ.t) =
match t with
| Typ.Tstruct { Typ.csu = Csu.Class csu; struct_name = Some c }
when csu = Csu.CPP || csu = Csu.Objc ->
Some (Typename.TN_csu (Csu.Class csu, c))
| Tstruct { name } -> Some name
| _ -> None
(** check if t1 is a subtype of t2 *)
@ -1584,16 +1581,13 @@ struct
then
check_subtype_java tenv t1 t2
else
match get_cpp_objc_type_name t1, get_cpp_objc_type_name t2 with
match get_type_name t1, get_type_name t2 with
| Some cn1, Some cn2 -> check_subclass tenv cn1 cn2
| _ -> false
let rec case_analysis_type_java tenv (t1, st1) (t2, st2) =
match t1, t2 with
| Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; struct_name = Some c1 },
Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; struct_name = Some c2 } ->
let cn1 = Typename.TN_csu (Csu.Class Csu.Java, c1)
and cn2 = Typename.TN_csu (Csu.Class Csu.Java, c2) in
| Typ.Tstruct { csu = Class Java; name = cn1 }, Typ.Tstruct { csu = Class Java; name = cn2 } ->
Subtype.case_analysis (cn1, st1) (cn2, st2)
(check_subclass tenv) (is_interface tenv)
@ -1603,8 +1597,7 @@ struct
| Typ.Tptr (dom_type1, _), Typ.Tptr (dom_type2, _) ->
case_analysis_type_java tenv (dom_type1, st1) (dom_type2, st2)
| Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; struct_name = Some c1 }, Typ.Tarray _ ->
let cn1 = Typename.TN_csu (Csu.Class Csu.Java, c1) in
| Typ.Tstruct { Typ.csu = Csu.Class Csu.Java; name = cn1 }, Typ.Tarray _ ->
if (Typename.equal cn1 serializable_type
|| Typename.equal cn1 cloneable_type
|| Typename.equal cn1 object_type) &&
@ -1617,7 +1610,7 @@ struct
let case_analysis_type tenv (t1, st1) (t2, st2) =
if is_java_class t1 then
case_analysis_type_java tenv (t1, st1) (t2, st2)
else match get_cpp_objc_type_name t1, get_cpp_objc_type_name t2 with
else match get_type_name t1, get_type_name t2 with
| Some cn1, Some cn2 ->
(* cn1 <: cn2 or cn2 <: cn1 is implied in Java when we get two types compared *)
(* that get through the type system, but not in C++ because of multiple inheritance, *)

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

@ -729,8 +729,8 @@ let add_guarded_by_constraints prop lexp pdesc =
let rec is_read_write_lock typ =
let str_is_read_write_lock str = string_is_suffix "ReadWriteUpdateLock" str in
match typ with
| Typ.Tstruct { struct_name=Some name} -> str_is_read_write_lock (Mangled.to_string name)
| Typ.Tvar name -> str_is_read_write_lock (Typename.to_string name)
| Typ.Tvar name
| Typ.Tstruct { name } -> str_is_read_write_lock (Typename.name name)
| Typ.Tptr (typ, _) -> is_read_write_lock typ
| _ -> false in
let has_lock guarded_by_exp =

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

@ -534,9 +534,7 @@ let resolve_typename prop receiver_exp =
| _ :: hpreds -> loop hpreds in
loop prop.Prop.sigma in
match typexp_opt with
| Some (Exp.Sizeof (Typ.Tstruct { Typ.struct_name = None }, _, _)) -> None
| Some (Exp.Sizeof (Typ.Tstruct { Typ.csu = Csu.Class ck; struct_name = Some name }, _, _)) ->
Some (Typename.TN_csu (Csu.Class ck, name))
| Some (Exp.Sizeof (Tstruct { name }, _, _)) -> Some name
| _ -> None
(** If the dynamic type of the receiver actual T_actual is a subtype of the reciever type T_formal

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

@ -624,9 +624,7 @@ let prop_get_exn_name pname prop =
let ret_pvar = Exp.Lvar (Pvar.get_ret_pvar pname) in
let rec search_exn e = function
| [] -> None
| Sil.Hpointsto (e1, _, Exp.Sizeof (Typ.Tstruct { Typ.struct_name = Some name }, _, _)) :: _
when Exp.equal e1 e ->
Some (Typename.TN_csu (Csu.Class Csu.Java, name))
| Sil.Hpointsto (e1, _, Sizeof (Tstruct { name }, _, _)) :: _ when Exp.equal e1 e -> Some name
| _ :: tl -> search_exn e tl in
let rec find_exn_name hpreds = function
| [] -> None

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

@ -19,7 +19,7 @@ let sources = [
{
classname = "com.facebook.infer.models.InferTaint";
method_name = "inferSecretSource";
ret_type = "java.lang.Object";
ret_type = JConfig.object_cl;
params = [];
is_static = true;
taint_kind = Tk_unknown;
@ -28,7 +28,7 @@ let sources = [
{
classname = "com.facebook.infer.models.InferTaint";
method_name = "inferSecretSourceUndefined";
ret_type = "java.lang.Object";
ret_type = JConfig.object_cl;
params = [];
is_static = true;
taint_kind = Tk_unknown;
@ -66,7 +66,7 @@ let sinks = [
classname = "com.facebook.infer.models.InferTaint";
method_name = "inferSensitiveSink";
ret_type = "void";
params = ["java.lang.Object"];
params = [JConfig.object_cl];
is_static = true;
taint_kind = Tk_unknown;
language = Config.Java
@ -75,7 +75,7 @@ let sinks = [
classname = "com.facebook.infer.models.InferTaint";
method_name = "inferSensitiveSinkUndefined";
ret_type = "void";
params = ["java.lang.Object"];
params = [JConfig.object_cl];
is_static = true;
taint_kind = Tk_unknown;
language = Config.Java

2
infer/src/checkers/fragmentRetainsViewChecker.ml
Unescape View File

@ -43,7 +43,7 @@ let callback_fragment_retains_view_java
let class_typename =
Typename.Java.from_string (Procname.java_get_class_name pname_java) in
match Tenv.lookup tenv class_typename with
| Some ({ Typ.struct_name = Some _; instance_fields } as struct_typ)
| Some ({ instance_fields } as struct_typ)
when AndroidFramework.is_fragment tenv struct_typ ->
let declared_view_fields =
IList.filter (is_declared_view_typ class_typename) instance_fields in

13
infer/src/checkers/immutableChecker.ml
Unescape View File

@ -24,18 +24,21 @@ let check_immutable_cast curr_pname curr_pdesc typ_expected typ_found_opt loc :
"java.util.Set", "com.google.common.collect.ImmutableSet"
] in
let in_casts expected given =
IList.exists (fun (x, y) -> Mangled.from_string x = expected && Mangled.from_string y = given) casts in
IList.exists (fun (x, y) ->
string_equal (Typename.name expected) x && string_equal (Typename.name given) y
) casts in
match PatternMatch.type_get_class_name typ_expected,
PatternMatch.type_get_class_name typ_found with
| Some name_expected, Some name_given ->
if in_casts name_expected name_given then
begin
let description =
Printf.sprintf
"Method %s returns %s but the return type is %s. Make sure that users of this method do not try to modify the collection."
Format.asprintf
"Method %s returns %a but the return type is %a. \
Make sure that users of this method do not try to modify the collection."
(Procname.to_simplified_string curr_pname)
(Mangled.to_string name_given)
(Mangled.to_string name_expected) in
Typename.pp name_given
Typename.pp name_expected in
Checkers.ST.report_error
curr_pname
curr_pdesc

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

@ -24,11 +24,8 @@ type taint_spec = {
language : Config.language
}
let object_name = Mangled.from_string "java.lang.Object"
let type_is_object = function
| Typ.Tptr (Typ.Tstruct { Typ.struct_name = Some name }, _) ->
Mangled.equal name object_name
| Typ.Tptr (Tstruct { name }, _) -> string_equal (Typename.name name) JConfig.object_cl
| _ -> false
let java_proc_name_with_class_method pn_java class_with_path method_name =
@ -87,11 +84,8 @@ let type_get_direct_supertypes = function
| _ ->
[]
let type_get_class_name t = match t with
| Typ.Tptr (Typ.Tstruct { Typ.struct_name = Some cn }, _) ->
Some cn
| Typ.Tptr (Typ.Tvar (Typename.TN_csu (Csu.Class _, cn)), _) ->
Some cn
let type_get_class_name = function
| Typ.Tptr (typ, _) -> Typ.name typ
| _ -> None
let type_get_annotation
@ -102,9 +96,6 @@ let type_get_annotation
Some struct_annotations
| _ -> None
let type_has_class_name t name =
type_get_class_name t = Some name
let type_has_direct_supertype (typ : Typ.t) (class_name : Typename.t) =
IList.exists (fun cn -> Typename.equal cn class_name) (type_get_direct_supertypes typ)
@ -133,21 +124,15 @@ let type_has_supertype
end in
has_supertype typ Typ.Set.empty
let type_is_nested_in_type t n = match t with
| Typ.Tptr (Typ.Tstruct { Typ.struct_name = Some name }, _) ->
string_is_prefix (Mangled.to_string n ^ "$") (Mangled.to_string name)
| _ -> false
let type_is_nested_in_direct_supertype t n =
let is_nested_in cn1 cn2 = string_is_prefix (Typename.name cn1 ^ "$") (Typename.name cn2) in
IList.exists (is_nested_in n) (type_get_direct_supertypes t)
let rec get_type_name = function
| Typ.Tstruct { Typ.struct_name = Some name } ->
Mangled.to_string name
| Typ.Tvar name
| Typ.Tstruct { name } ->
Typename.name name
| Typ.Tptr (t, _) -> get_type_name t
| Typ.Tvar tn -> Typename.name tn
| _ -> "_"
let get_field_type_name

7
infer/src/checkers/patternMatch.mli
Unescape View File

@ -87,13 +87,10 @@ val proc_iter_overridden_methods : (Procname.t -> unit) -> Tenv.t -> Procname.t
val type_get_annotation : Typ.t -> Typ.item_annotation option
(** Get the class name of the type *)
val type_get_class_name : Typ.t -> Mangled.t option
val type_get_class_name : Typ.t -> Typename.t option
val type_get_direct_supertypes : Typ.t -> Typename.t list
(** Is the type a class with the given name *)
val type_has_class_name : Typ.t -> Mangled.t -> bool
val type_has_direct_supertype : Typ.t -> Typename.t -> bool
(** Is the type a class type *)
@ -101,8 +98,6 @@ val type_is_class : Typ.t -> bool
val type_is_nested_in_direct_supertype : Typ.t -> Typename.t -> bool
val type_is_nested_in_type : Typ.t -> Mangled.t -> bool
(** Is the type java.lang.Object *)
val type_is_object : Typ.t -> bool

2
infer/src/checkers/printfArgs.ml
Unescape View File

@ -61,7 +61,7 @@ let default_format_type_name
| "c" -> "java.lang.Character"
| "b" -> "java.lang.Boolean"
| "s" -> "java.lang.String"
| "h" | "H" -> "java.lang.Object"
| "h" | "H" -> JConfig.object_cl
| _ -> "unknown"
let format_type_matches_given_type

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

@ -88,7 +88,7 @@ let add_missing_fields tenv class_name ck fields =
Typ.instance_fields = new_fields;
static_fields = [];
csu = Csu.Class ck;
struct_name = Some mang_name;
name = class_tn_name;
} in
Printing.log_out " Updating info for class '%s' in tenv\n" class_name;
Tenv.add tenv class_tn_name class_type_info

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

@ -125,18 +125,18 @@ struct
IList.iter (fun (fn, _, _) ->
Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields;
let mblock = Mangled.from_string block_name in
let block_name = Typename.TN_csu (Csu.Class Csu.Objc, mblock) in
let block_struct_typ =
{
Typ.instance_fields = fields;
static_fields = [];
csu = Csu.Class Csu.Objc;
struct_name = Some mblock;
name = block_name;
superclasses = [];
def_methods = [];
struct_annotations = [];
} in
let block_type = Typ.Tstruct block_struct_typ in
let block_name = Typename.TN_csu (Csu.Class Csu.Objc, mblock) in
Tenv.add tenv block_name block_struct_typ;
let trans_res =
CTrans_utils.alloc_trans

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

@ -14,11 +14,6 @@ open! Utils
open CFrontend_utils
module L = Logging
let get_name_from_struct s =
match s with
| Typ.Tstruct { Typ.struct_name = Some n } -> n
| _ -> assert false
let add_pointer_to_typ typ =
Typ.Tptr(typ, Typ.Pk_pointer)
@ -29,8 +24,8 @@ let remove_pointer_to_typ typ =
let classname_of_type typ =
match typ with
| Typ.Tvar (Typename.TN_csu (_, name) )
| Typ.Tstruct { struct_name = Some name } -> Mangled.to_string name
| Typ.Tvar name
| Typ.Tstruct { name } -> Typename.name name
| Typ.Tfun _ -> CFrontend_config.objc_object
| _ ->
Printing.log_out
@ -43,9 +38,9 @@ let mk_structname n = Typename.TN_csu (Csu.Struct, Mangled.from_string n)
let is_class typ =
match typ with
| Typ.Tptr (Typ.Tstruct { Typ.struct_name = Some name }, _)
| Typ.Tptr (Typ.Tvar (Typename.TN_csu (_, name) ), _) ->
(Mangled.to_string name) = CFrontend_config.objc_class
| Typ.Tptr (Tvar ((TN_csu _) as name), _)
| Typ.Tptr (Tstruct { name }, _) ->
string_equal (Typename.name name) CFrontend_config.objc_class
| _ -> false
let rec return_type_of_function_type_ptr type_ptr =

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

@ -19,8 +19,6 @@ val mk_classname : string -> Csu.class_kind -> Typename.t
val mk_structname : string -> Typename.t
val get_name_from_struct: Typ.t -> Mangled.t
val remove_pointer_to_typ : Typ.t -> Typ.t
val is_class : Typ.t -> bool

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

@ -22,7 +22,7 @@ let add_predefined_objc_types tenv =
Typ.instance_fields = [];
static_fields = [];
csu = Csu.Struct;
struct_name = Some (Mangled.from_string CFrontend_config.objc_class);
name = TN_csu (Struct, Mangled.from_string CFrontend_config.objc_class);
superclasses = [];
def_methods = [];
struct_annotations = [];
@ -34,7 +34,7 @@ let add_predefined_objc_types tenv =
Typ.instance_fields = [];
static_fields = [];
csu = Csu.Struct;
struct_name = Some (Mangled.from_string CFrontend_config.objc_object);
name = TN_csu (Struct, Mangled.from_string CFrontend_config.objc_object);
superclasses = [];
def_methods = [];
struct_annotations = [];
@ -140,12 +140,10 @@ let get_superclass_list_cpp decl =
IList.map get_super_field base_decls
let add_struct_to_tenv tenv typ =
let csu, struct_typ = match typ with
| Typ.Tstruct ({ Typ.csu } as struct_typ) -> csu, struct_typ
| _ -> assert false in
let mangled = CTypes.get_name_from_struct typ in
let typename = Typename.TN_csu(csu, mangled) in
Tenv.add tenv typename struct_typ
match typ with
| Typ.Tstruct ({name} as struct_typ) ->
Tenv.add tenv name struct_typ
| _ -> assert false
let get_translate_as_friend_decl decl_list =
let is_translate_as_friend_name (_, name_info) =
@ -226,7 +224,7 @@ and get_record_declaration_struct_type tenv decl =
Typ.instance_fields = non_static_fields;
static_fields;
csu;
struct_name = Some mangled_name;
name = sil_typename;
superclasses;
def_methods;
struct_annotations;
@ -249,7 +247,7 @@ and get_record_declaration_struct_type tenv decl =
Typ.instance_fields = extra_fields;
static_fields = [];
csu;
struct_name = Some mangled_name;
name = sil_typename;
superclasses = [];
def_methods = [];
struct_annotations;

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

@ -87,7 +87,7 @@ let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list =
Typ.instance_fields = new_fields;
static_fields = [];
csu = Csu.Class Csu.Objc;
struct_name = Some mang_name;
name = class_tn_name;
def_methods = new_methods;
} in
Printing.log_out " Updating info for class '%s' in tenv\n" class_name;

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

@ -133,7 +133,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info name_info d
Typ.instance_fields = all_fields;
static_fields = [];
csu = Csu.Class Csu.Objc;
struct_name = Some (Mangled.from_string class_name);
name = interface_name;
superclasses;
def_methods = methods;
struct_annotations = Typ.objc_class_annotation;
@ -155,7 +155,6 @@ let add_missing_methods tenv class_name ck decl_info decl_list curr_class =
match Tenv.lookup tenv class_tn_name with
| Some ({ Typ.static_fields = [];
csu = Csu.Class _;
struct_name = Some _;
def_methods;
} as struct_typ) ->
let methods = General_utils.append_no_duplicates_methods def_methods methods in

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

@ -38,7 +38,7 @@ let protocol_decl type_ptr_to_sil_type tenv decl =
Typ.instance_fields = [];
static_fields = [];
csu = Csu.Protocol;
struct_name = Some mang_name;
name = protocol_name;
superclasses = [];
def_methods;
struct_annotations = [];

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

@ -134,10 +134,9 @@ let check_condition case_zero find_canonical_duplicate curr_pname
(* That always happens in the bytecode generated by try-with-resources. *)
let loc = Cfg.Node.get_loc node in
let throwable_found = ref false in
let throwable_class = Mangled.from_string "java.lang.Throwable" in
let typ_is_throwable = function
| Typ.Tstruct { Typ.csu = Csu.Class _; struct_name = Some c } ->
Mangled.equal c throwable_class
| Typ.Tstruct { csu = Class _; name } ->
string_equal (Typename.name name) "java.lang.Throwable"
| _ -> false in
let do_instr = function
| Sil.Call (_, Exp.Const (Const.Cfun pn), [_; (Exp.Sizeof(t, _, _), _)], _, _) when
@ -257,7 +256,7 @@ let check_constructor_initialization
if Procname.is_constructor curr_pname
then begin
match PatternMatch.get_this_type (Cfg.Procdesc.get_attributes curr_pdesc) with
| Some (Typ.Tptr (Typ.Tstruct { Typ.instance_fields; struct_name } as ts, _)) ->
| Some (Tptr (Tstruct { instance_fields; name } as ts, _)) ->
let do_field (fn, ft, _) =
let annotated_with f = match get_field_annotation fn ts with
| None -> false
@ -294,9 +293,7 @@ let check_constructor_initialization
let should_check_field_initialization =
let in_current_class =
let fld_cname = Ident.java_fieldname_get_class fn in
match struct_name with
| None -> false
| Some name -> Mangled.equal name (Mangled.from_string fld_cname) in
string_equal (Typename.name name) fld_cname in
not injector_readonly_annotated &&
PatternMatch.type_is_class ft &&
in_current_class &&

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

@ -87,7 +87,7 @@ let is_android_lib_class class_name =
a list of method names [lifecycle_procs_strs], get the appropriate typ and procnames *)
let get_lifecycle_for_framework_typ_opt tenv lifecycle_typ lifecycle_proc_strs =
match Tenv.lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, lifecycle_typ)) with
| Some ({ Typ.csu = Csu.Class _; struct_name = Some _; def_methods } as lifecycle_typ) ->
| Some ({ Typ.csu = Csu.Class _; 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 ->

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

@ -18,16 +18,15 @@ module F = Format
constituting a lifecycle trace *)
let try_create_lifecycle_trace struct_typ lifecycle_struct_typ lifecycle_procs tenv =
match struct_typ with
| { Typ.csu = Csu.Class Java; struct_name = Some name } ->
let class_name = Typename.TN_csu (Csu.Class Java, name) in
| { Typ.csu = Class Java; name } ->
if PatternMatch.is_subtype tenv struct_typ lifecycle_struct_typ &&
not (AndroidFramework.is_android_lib_class class_name) then
not (AndroidFramework.is_android_lib_class name) then
let ptr_to_struct_typ = Some (Typ.Tptr (Tstruct struct_typ, Pk_pointer)) in
IList.fold_left
(fun trace lifecycle_proc ->
(* given a lifecycle subclass T, resolve the call T.lifecycle_proc() to the procname
* that will actually be called at runtime *)
let resolved_proc = SymExec.resolve_method tenv class_name lifecycle_proc in
let resolved_proc = SymExec.resolve_method tenv name lifecycle_proc in
(resolved_proc, ptr_to_struct_typ) :: trace)
[]
lifecycle_procs
@ -50,9 +49,7 @@ let create_harness cfg cg tenv =
| [] -> ()
| lifecycle_trace ->
let harness_procname =
let harness_cls_name = match struct_typ.Typ.struct_name with
| Some name -> Mangled.to_string name
| None -> "NONE" in
let harness_cls_name = Typename.name struct_typ.name in
let pname =
Procname.Java
(Procname.java

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

@ -88,9 +88,8 @@ let rec create_array_type typ dim =
let extract_cn_no_obj typ =
match typ with
| Typ.Tptr (Typ.Tstruct { Typ.csu = Csu.Class _; struct_name = Some classname },
Typ.Pk_pointer) ->
let class_name = (Mangled.to_string classname) in
| Typ.Tptr (Tstruct { csu = Class _; name }, Pk_pointer) ->
let class_name = Typename.name name in
if class_name = JConfig.object_cl then None
else
let jbir_class_name = (JBasics.make_cn class_name) in
@ -236,12 +235,11 @@ let collect_interface_field cn inf l =
let dummy_type cn =
let classname = Mangled.from_string (JBasics.cn_name cn) in
Typ.Tstruct {
Typ.instance_fields = [];
static_fields = [];
csu = Csu.Class Csu.Java;
struct_name = Some classname;
name = Typename.Java.from_string (JBasics.cn_name cn);
superclasses = [];
def_methods = [];
struct_annotations = Typ.item_annotation_empty;
@ -333,18 +331,16 @@ and create_sil_type program tenv cn =
| Some super_cn ->
let super_classname =
match get_class_type_no_pointer program tenv super_cn with
| Typ.Tstruct { Typ.struct_name = Some classname } ->
Typename.TN_csu (Csu.Class Csu.Java, classname)
| Typ.Tstruct { name } -> name
| _ -> assert false in
super_classname :: interface_list in
(super_classname_list, nonstatic_fields, static_fields, item_annotation) in
let classname = Mangled.from_string (JBasics.cn_name cn) in
let def_methods = IList.map (fun j -> Procname.Java j) (get_class_procnames cn node) in
Typ.Tstruct {
Typ.instance_fields;
static_fields;
csu = Csu.Class Csu.Java;
struct_name = Some classname;
name = Typename.Java.from_string (JBasics.cn_name cn);
superclasses;
def_methods;
struct_annotations;

Write Preview
Loading…
Cancel
Save