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

fixing tenv_lookup

Browse Source 
Reviewed By: cristianoc

Differential Revision: D2991693

fb-gh-sync-id: 3139630
shipit-source-id: 3139630
master
Sam Blackshear 9 years ago committed by Facebook Github Bot 7
parent 337d2cc537
commit 2d89426170
21 changed files with 65 additions and 105 deletions
Show Stats Download Patch File Download Diff File

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

@ -412,7 +412,7 @@ let typ_get_recursive_flds tenv typ_exp =
| None -> | None ->
L.err "@.typ_get_recursive: Undefined type %s@." (Typename.to_string tname'); L.err "@.typ_get_recursive: Undefined type %s@." (Typename.to_string tname');
t t
| Some typ' -> typ' in | Some st -> Sil.Tstruct st in
Sil.typ_equal typ' typ Sil.typ_equal typ' typ
| Sil.Tptr _ | Sil.Tstruct _ | Sil.Tarray _ -> | Sil.Tptr _ | Sil.Tstruct _ | Sil.Tarray _ ->
false false

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

@ -1106,19 +1106,7 @@ let rec create_strexp_of_type tenvo struct_init_mode typ inst =
end end
| Sil.Tarray (_, size) -> | Sil.Tarray (_, size) ->
Sil.Earray (size, [], inst) Sil.Earray (size, [], inst)
| Sil.Tvar name -> | Sil.Tvar _ ->
L.out "@[<2>ANALYSIS BUG@\n";
L.out "type %a should be expanded to " (Sil.pp_typ_full pe_text) typ;
begin
match tenvo with
| None -> L.out "nothing@\n@."
| Some tenv ->
begin
match Sil.tenv_lookup tenv name with
| None -> L.out "nothing@\n@."
| Some typ' -> L.out "%a@\n@." (Sil.pp_typ_full pe_text) typ'
end;
end;
assert false assert false
(** Sil.Construct a pointsto. *) (** Sil.Construct a pointsto. *)

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

@ -1454,7 +1454,7 @@ struct
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 Csu.Java; struct_name = Some _ } as struct_typ )) -> | Some ({ Sil.csu = Csu.Class Csu.Java; 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
@ -1472,7 +1472,7 @@ struct
let rec check cn = let rec check cn =
Typename.equal cn c2 || is_root_class c2 || Typename.equal cn c2 || is_root_class c2 ||
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.struct_name = Some _; csu = Csu.Class _; superclasses }) ->
IList.exists check superclasses IList.exists check superclasses
| _ -> false in | _ -> false in
check c1 check c1
@ -1944,7 +1944,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 *
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
Sil.Sizeof (typ, Sil.Subtype.exact) in Sil.Sizeof (Sil.Tstruct typ, Sil.Subtype.exact) in
Sil.Hpointsto (root, sexp, const_string_texp) in Sil.Hpointsto (root, sexp, const_string_texp) in
let mk_constant_class_hpred s = (* creat an hpred from a constant class *) let mk_constant_class_hpred s = (* creat an hpred from a constant class *)
let root = Sil.Const (Sil.Cclass (Ident.string_to_name s)) in let root = Sil.Const (Sil.Cclass (Ident.string_to_name s)) in
@ -1956,7 +1956,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 *
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
Sil.Sizeof (typ, Sil.Subtype.exact) in Sil.Sizeof (Sil.Tstruct typ, Sil.Subtype.exact) in
Sil.Hpointsto (root, sexp, class_texp) in Sil.Hpointsto (root, sexp, class_texp) in
try try
(match move_primed_lhs_from_front subs sigma2 with (match move_primed_lhs_from_front subs sigma2 with

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

@ -3770,7 +3770,7 @@ let tenv_mem tenv name =
(** Look up a name in the global type environment. *) (** Look up a name in the global type environment. *)
let tenv_lookup tenv name = let tenv_lookup tenv name =
try Some (Tstruct (TypenameHash.find tenv name)) try Some (TypenameHash.find tenv name)
with Not_found -> None with Not_found -> None
(** Add a (name,type) pair to the global type environment. *) (** Add a (name,type) pair to the global type environment. *)
@ -3784,7 +3784,7 @@ let expand_type tenv typ =
begin begin
match tenv_lookup tenv tname with match tenv_lookup tenv tname with
| None -> assert false | None -> assert false
| Some typ' -> typ' | Some struct_typ -> Tstruct struct_typ
end end
| _ -> typ | _ -> typ

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

@ -522,7 +522,7 @@ val create_tenv : unit -> tenv
val tenv_mem : tenv -> Typename.t -> bool val tenv_mem : tenv -> Typename.t -> bool
(** Look up a name in the global type environment. *) (** Look up a name in the global type environment. *)
val tenv_lookup : tenv -> Typename.t -> typ option val tenv_lookup : tenv -> Typename.t -> struct_typ option
(** Add a (name,typ) pair to the global type environment. *) (** Add a (name,typ) pair to the global type environment. *)
val tenv_add : tenv -> Typename.t -> struct_typ -> unit val tenv_add : tenv -> Typename.t -> struct_typ -> unit

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

@ -547,7 +547,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.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
@ -601,7 +601,7 @@ let lookup_java_typ_from_string tenv 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 Csu.Java, (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 struct_typ -> Sil.Tstruct struct_typ
| _ -> raise (Cannot_convert_string_to_typ typ_str) in | _ -> raise (Cannot_convert_string_to_typ typ_str) in
loop typ_str loop typ_str
@ -772,30 +772,6 @@ let redirect_shared_ptr tenv cfg pname actual_params =
pname' pname'
else pname else pname
(** Lookup Java types by name *)
let lookup_java_typ_from_string tenv typ_str =
let rec loop = function
| "" | "void" -> Sil.Tvoid
| "int" -> Sil.Tint Sil.IInt
| "byte" -> Sil.Tint Sil.IShort
| "short" -> Sil.Tint Sil.IShort
| "boolean" -> Sil.Tint Sil.IBool
| "char" -> Sil.Tint Sil.IChar
| "long" -> Sil.Tint Sil.ILong
| "float" -> Sil.Tfloat Sil.FFloat
| "double" -> Sil.Tfloat Sil.FDouble
| typ_str when String.contains typ_str '[' ->
let stripped_typ = String.sub typ_str 0 ((String.length typ_str) - 2) in
let array_typ_size = Sil.exp_get_undefined false in
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 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
loop typ_str
(** recognize calls to the constructor java.net.URL and splits the argument string (** recognize calls to the constructor java.net.URL and splits the argument string
to be only the protocol. *) to be only the protocol. *)
let call_constructor_url_update_args pname actual_params = let call_constructor_url_update_args pname actual_params =

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

@ -67,7 +67,8 @@ let callback_checker_main
Typename.TN_csu Typename.TN_csu
(Csu.Class Csu.Java, Mangled.from_string (Procname.java_get_class proc_name)) in (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 { struct_name = Some _; def_methods } as typ) -> | Some ({ struct_name = Some _; def_methods } as struct_typ) ->
let typ = Sil.Tstruct struct_typ in
let lifecycle_typs = get_or_create_lifecycle_typs tenv in let lifecycle_typs = get_or_create_lifecycle_typs tenv in
let proc_belongs_to_lifecycle_typ = IList.exists let proc_belongs_to_lifecycle_typ = IList.exists
(fun lifecycle_typ -> AndroidFramework.typ_is_lifecycle_typ typ lifecycle_typ tenv) (fun lifecycle_typ -> AndroidFramework.typ_is_lifecycle_typ typ lifecycle_typ tenv)

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

@ -27,7 +27,7 @@ let callback_fragment_retains_view { Callbacks.proc_desc; proc_name; tenv } =
| Sil.Tptr (Sil.Tvar tname, _) -> | Sil.Tptr (Sil.Tvar tname, _) ->
begin begin
match Sil.tenv_lookup tenv tname with match Sil.tenv_lookup tenv tname with
| Some typ -> AndroidFramework.is_view typ tenv | Some struct_typ -> AndroidFramework.is_view (Sil.Tstruct struct_typ) tenv
| None -> false | None -> false
end end
| _ -> false in | _ -> false in
@ -39,8 +39,8 @@ let callback_fragment_retains_view { Callbacks.proc_desc; proc_name; tenv } =
begin begin
let class_typename = Typename.Java.from_string (Procname.java_get_class proc_name) in let class_typename = Typename.Java.from_string (Procname.java_get_class proc_name) in
match Sil.tenv_lookup tenv class_typename with match Sil.tenv_lookup tenv class_typename with
| Some (Sil.Tstruct { Sil.struct_name = Some _; instance_fields } | Some ({ Sil.struct_name = Some _; instance_fields } as struct_typ)
as typ) when AndroidFramework.is_fragment typ tenv -> when AndroidFramework.is_fragment (Sil.Tstruct struct_typ) tenv ->
let declared_view_fields = let declared_view_fields =
IList.filter (is_declared_view_typ class_typename) instance_fields in IList.filter (is_declared_view_typ class_typename) instance_fields in
let fields_nullified = PatternMatch.get_fields_nullified proc_desc in let fields_nullified = PatternMatch.get_fields_nullified proc_desc in
@ -48,7 +48,7 @@ let callback_fragment_retains_view { Callbacks.proc_desc; proc_name; tenv } =
IList.iter IList.iter
(fun (fname, fld_typ, _) -> (fun (fname, fld_typ, _) ->
if not (Ident.FieldSet.mem fname fields_nullified) then if not (Ident.FieldSet.mem fname fields_nullified) then
report_error typ fname fld_typ proc_name proc_desc) report_error (Sil.Tstruct struct_typ) fname fld_typ proc_name proc_desc)
declared_view_fields declared_view_fields
| _ -> () | _ -> ()
end end

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

@ -79,7 +79,8 @@ let type_has_supertype
let match_name () = Typename.equal cn class_name in let match_name () = Typename.equal cn class_name in
let has_indirect_supertype () = let has_indirect_supertype () =
match Sil.tenv_lookup tenv cn with match Sil.tenv_lookup tenv cn with
| Some supertype -> has_supertype supertype (Sil.TypSet.add typ visited) | Some supertype ->
has_supertype (Sil.Tstruct supertype) (Sil.TypSet.add typ visited)
| None -> false in | None -> false in
(match_name () || has_indirect_supertype ()) in (match_name () || has_indirect_supertype ()) in
IList.exists match_supertype superclasses IList.exists match_supertype superclasses
@ -305,7 +306,7 @@ let proc_iter_overridden_methods f tenv proc_name =
let super_proc_name = let super_proc_name =
Procname.java_replace_class proc_name (Typename.name super_class_name) in Procname.java_replace_class proc_name (Typename.name super_class_name) in
match Sil.tenv_lookup tenv super_class_name with match Sil.tenv_lookup tenv super_class_name with
| Some (Sil.Tstruct { Sil.def_methods }) -> | Some ({ Sil.def_methods }) ->
let is_override pname = let is_override pname =
Procname.equal pname super_proc_name && Procname.equal pname super_proc_name &&
not (Procname.is_constructor pname) in not (Procname.is_constructor pname) in
@ -321,8 +322,8 @@ let proc_iter_overridden_methods f tenv proc_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 Csu.Java, 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_struct_typ ->
IList.iter (do_super_type tenv) (type_get_direct_supertypes curr_type) IList.iter (do_super_type tenv) (type_get_direct_supertypes (Sil.Tstruct curr_struct_typ))
| None -> () | None -> ()
(** return the set of instance fields that are assigned to a null literal in [procdesc] *) (** return the set of instance fields that are assigned to a null literal in [procdesc] *)

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

@ -87,7 +87,8 @@ let is_modeled_expensive tenv pname =
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 Csu.Java, classname)) with match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, classname)) with
| None -> false | None -> false
| Some typ -> | Some struct_typ ->
let typ = Sil.Tstruct struct_typ in
AndroidFramework.is_view typ tenv AndroidFramework.is_view typ tenv
|| AndroidFramework.is_activity typ tenv || AndroidFramework.is_activity typ tenv

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

@ -117,7 +117,7 @@ let curr_class_hash curr_class =
let create_curr_class tenv class_name ck = let create_curr_class tenv class_name ck =
let class_tn_name = Typename.TN_csu (Csu.Class ck, (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.superclasses } ->
(let superclasses_names = IList.map Typename.name superclasses in (let superclasses_names = IList.map Typename.name superclasses in
match superclasses_names with match superclasses_names with
| superclass:: protocols -> | superclass:: protocols ->

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

@ -19,11 +19,10 @@ let rec get_fields_super_classes tenv super_class =
Printing.log_out " ... Getting fields of superclass '%s'\n" (Typename.to_string super_class); Printing.log_out " ... Getting fields of superclass '%s'\n" (Typename.to_string super_class);
match Sil.tenv_lookup tenv super_class with match Sil.tenv_lookup tenv super_class with
| None -> [] | None -> []
| Some Sil.Tstruct { Sil.instance_fields; superclasses = super_class :: _ } -> | Some { Sil.instance_fields; superclasses = super_class :: _ } ->
let sc_fields = get_fields_super_classes tenv super_class in let sc_fields = get_fields_super_classes tenv super_class in
General_utils.append_no_duplicates_fields instance_fields sc_fields General_utils.append_no_duplicates_fields instance_fields sc_fields
| Some Sil.Tstruct { Sil.instance_fields } -> instance_fields | Some { Sil.instance_fields } -> instance_fields
| Some _ -> []
let fields_superclass tenv interface_decl_info ck = 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
@ -78,7 +77,7 @@ 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 ck, 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.instance_fields } as struct_typ) ->
let new_fields = General_utils.append_no_duplicates_fields instance_fields fields in let new_fields = General_utils.append_no_duplicates_fields instance_fields fields in
let class_type_info = let class_type_info =
{ {

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

@ -69,7 +69,7 @@ let direct_atomic_property_access_warning context stmt_info ivar_name =
| _ -> Ident.create_fieldname (Mangled.from_string "") 0, "" in | _ -> Ident.create_fieldname (Mangled.from_string "") 0, "" in
let tname = Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string cname) in let tname = Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string cname) in
let condition = match Sil.tenv_lookup tenv tname with let condition = match Sil.tenv_lookup tenv tname with
| Some Sil.Tstruct { Sil.instance_fields; static_fields } -> | Some { Sil.instance_fields; static_fields } ->
(* We give the warning when: (* We give the warning when:
(1) the property has the atomic attribute and (1) the property has the atomic attribute and
(2) the access of the ivar is not in a getter or setter method. (2) the access of the ivar is not in a getter or setter method.

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

@ -228,7 +228,7 @@ let get_superclass_curr_class_objc context =
let iname = Typename.TN_csu (Csu.Class Csu.Objc, 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.superclasses = super_name :: _ } ->
Typename.name super_name Typename.name super_name
| _ -> | _ ->
Printing.log_err "NOT FOUND superclass = '%s'\n\n%!" (Typename.to_string iname); Printing.log_err "NOT FOUND superclass = '%s'\n\n%!" (Typename.to_string iname);

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

@ -1525,12 +1525,7 @@ struct
match typ with match typ with
| Sil.Tvar tn -> | Sil.Tvar tn ->
(match Sil.tenv_lookup context.CContext.tenv tn with (match Sil.tenv_lookup context.CContext.tenv tn with
| Some (Sil.Tstruct _ as str) -> collect_left_hand_exprs e str tns | Some struct_typ -> collect_left_hand_exprs e (Sil.Tstruct struct_typ) tns
| Some ((Sil.Tvar typename) as tvar) ->
if (StringSet.mem (Typename.to_string typename) tns) then
[[(e, typ)]]
else
collect_left_hand_exprs e tvar (StringSet.add (Typename.to_string typename) tns)
| _ -> [[(e, typ)]] (*This case is an error, shouldn't happen.*)) | _ -> [[(e, typ)]] (*This case is an error, shouldn't happen.*))
| Sil.Tstruct { Sil.instance_fields } as type_struct -> | Sil.Tstruct { Sil.instance_fields } as type_struct ->
let lh_exprs = IList.map ( fun (fieldname, _, _) -> let lh_exprs = IList.map ( fun (fieldname, _, _) ->

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

@ -86,7 +86,8 @@ let rec expand_structured_type tenv typ =
match typ with match typ with
| Sil.Tvar tn -> | Sil.Tvar tn ->
(match Sil.tenv_lookup tenv tn with (match Sil.tenv_lookup tenv tn with
| Some t -> | Some ts ->
let t = Sil.Tstruct ts in
Printing.log_out " Type expanded with type '%s' found in tenv@." (Sil.typ_to_string t); Printing.log_out " Type expanded with type '%s' found in tenv@." (Sil.typ_to_string t);
if Sil.typ_equal t typ then if Sil.typ_equal t typ then
typ typ

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

@ -201,7 +201,7 @@ and get_struct_cpp_class_declaration_type tenv decl =
sil_type sil_type
) else ( ) else (
match Sil.tenv_lookup tenv sil_typename with match Sil.tenv_lookup tenv sil_typename with
| Some sil_type -> sil_type (* just reuse what is already in tenv *) | Some struct_typ -> Sil.Tstruct struct_typ (* just reuse what is already in tenv *)
| None -> | None ->
(* This is first forward definition seen so far. Instead of adding *) (* This is first forward definition seen so far. Instead of adding *)
(* empty Tstruct to sil_types_map add Tvar so that frontend doeasn't expand *) (* empty Tstruct to sil_types_map add Tvar so that frontend doeasn't expand *)

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

@ -76,9 +76,7 @@ let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list =
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.instance_fields; def_methods } as struct_typ) ->
({ Sil.instance_fields; def_methods }
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
let new_methods = General_utils.append_no_duplicates_methods methods def_methods in let new_methods = General_utils.append_no_duplicates_methods methods def_methods in
let class_type_info = let class_type_info =

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

@ -22,7 +22,7 @@ let is_pointer_to_objc_class tenv typ =
match typ with match typ with
| Sil.Tptr (Sil.Tvar (Typename.TN_csu (Csu.Class Csu.Objc, cname)), _) -> | 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 (match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Objc, cname)) with
| Some typ when Sil.is_objc_class typ -> true | Some struct_typ when Sil.is_objc_class (Sil.Tstruct struct_typ) -> true
| _ -> false) | _ -> false)
| Sil.Tptr (typ, _) when Sil.is_objc_class typ -> true | Sil.Tptr (typ, _) when Sil.is_objc_class typ -> true
| _ -> false | _ -> false
@ -113,7 +113,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name
(*In case we found categories, or partial definition of this class earlier and they are already in the tenv *) (*In case we found categories, or partial definition of this class earlier and they are already in the tenv *)
let fields, (superclasses : Typename.t list), methods = let fields, (superclasses : Typename.t list), methods =
match Sil.tenv_lookup tenv interface_name with match Sil.tenv_lookup tenv interface_name with
| Some (Sil.Tstruct { Sil.instance_fields; superclasses; def_methods }) -> | Some ({ Sil.instance_fields; superclasses; def_methods }) ->
General_utils.append_no_duplicates_fields fields instance_fields, General_utils.append_no_duplicates_fields fields instance_fields,
General_utils.append_no_duplicates_csu superclasses superclasses, General_utils.append_no_duplicates_csu superclasses superclasses,
General_utils.append_no_duplicates_methods methods def_methods General_utils.append_no_duplicates_methods methods def_methods
@ -138,7 +138,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name
Printing.log_out Printing.log_out
" >>>Verifying that Typename '%s' is in tenv\n" (Typename.to_string interface_name); " >>>Verifying that Typename '%s' is in tenv\n" (Typename.to_string interface_name);
(match Sil.tenv_lookup tenv interface_name with (match Sil.tenv_lookup tenv interface_name with
| Some t -> Printing.log_out " >>>OK. Found typ='%s'\n" (Sil.typ_to_string t) | Some st -> Printing.log_out " >>>OK. Found typ='%s'\n" (Sil.typ_to_string (Sil.Tstruct st))
| None -> Printing.log_out " >>>NOT Found!!\n"); | None -> Printing.log_out " >>>NOT Found!!\n");
Sil.Tvar interface_name Sil.Tvar interface_name
@ -147,17 +147,18 @@ let add_missing_methods tenv class_name ck decl_info decl_list curr_class =
let class_tn_name = Typename.TN_csu (Csu.Class ck, (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 begin
| Some Sil.Tstruct match Sil.tenv_lookup tenv class_tn_name with
({ Sil.static_fields = []; | Some ({ Sil.static_fields = [];
csu = Csu.Class _; csu = Csu.Class _;
struct_name = Some _; struct_name = Some _;
def_methods; def_methods;
} as struct_typ) -> } as struct_typ) ->
let methods = General_utils.append_no_duplicates_methods def_methods methods in let methods = General_utils.append_no_duplicates_methods def_methods methods in
let struct_typ' = { struct_typ with Sil.def_methods = methods; } in let struct_typ' = { struct_typ with Sil.def_methods = methods; } in
Sil.tenv_add tenv class_tn_name struct_typ' Sil.tenv_add tenv class_tn_name struct_typ'
| _ -> ()); | _ -> ()
end;
Sil.Tvar class_tn_name Sil.Tvar class_tn_name
(* Interface_type_info has the name of instance variables and the name of methods. *) (* Interface_type_info has the name of instance variables and the name of methods. *)

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

@ -256,7 +256,9 @@ let get_all_supertypes typ tenv =
| _ -> [] in | _ -> [] in
let rec add_typ class_name typs = let rec add_typ class_name typs =
match Sil.tenv_lookup tenv class_name with match Sil.tenv_lookup tenv class_name with
| Some typ -> get_supers_rec typ (TypSet.add typ typs) | Some struct_typ ->
let typ' = Sil.Tstruct struct_typ in
get_supers_rec typ' (TypSet.add typ' typs)
| None -> typs | None -> typs
and get_supers_rec typ all_supers = and get_supers_rec typ all_supers =
let direct_supers = get_direct_supers typ in let direct_supers = get_direct_supers typ in
@ -272,7 +274,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 Csu.Java, 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_struct_typ -> is_subtype typ (Sil.Tstruct found_struct_typ) tenv
| _ -> false | _ -> false
let is_context typ tenv = let is_context typ tenv =
@ -353,8 +355,7 @@ let get_callbacks_registered_by_proc procdesc tenv =
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 Csu.Java, lifecycle_typ)) with match Sil.tenv_lookup tenv (Typename.TN_csu (Csu.Class Csu.Java, lifecycle_typ)) with
| Some (Sil.Tstruct | Some ({ 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 ->
@ -366,7 +367,7 @@ let get_lifecycle_for_framework_typ_opt lifecycle_typ lifecycle_proc_strs tenv =
try (lookup_proc lifecycle_proc_str) :: lifecycle_procs try (lookup_proc lifecycle_proc_str) :: lifecycle_procs
with Not_found -> lifecycle_procs) with Not_found -> lifecycle_procs)
[] lifecycle_proc_strs in [] lifecycle_proc_strs in
Some (lifecycle_typ, lifecycle_procs) Some (Sil.Tstruct lifecycle_typ, lifecycle_procs)
| _ -> None | _ -> None
(** return the complete list of (package, lifecycle_classname, lifecycle_methods) trios *) (** return the complete list of (package, lifecycle_classname, lifecycle_methods) trios *)
@ -379,7 +380,7 @@ let is_subclass tenv cn1 classname_str =
let lookup = Sil.tenv_lookup tenv in let lookup = Sil.tenv_lookup tenv in
match lookup cn1, lookup typename with match lookup cn1, lookup typename with
| Some typ1, Some typ2 -> | Some typ1, Some typ2 ->
is_subtype typ1 typ2 tenv is_subtype (Sil.Tstruct typ1) (Sil.Tstruct typ2) tenv
| _ -> false | _ -> false

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

@ -349,18 +349,16 @@ and create_sil_type program tenv cn =
struct_annotations; struct_annotations;
} }
and get_class_type_no_pointer program tenv cn = and get_class_type_no_pointer program tenv cn =
let named_type = typename_of_classname cn in let named_type = typename_of_classname cn in
let class_type_np = match Sil.tenv_lookup tenv named_type with
match Sil.tenv_lookup tenv named_type with | None ->
| None -> create_sil_type program tenv cn (match create_sil_type program tenv cn with
| Some t -> t in | (Sil.Tstruct struct_typ) as typ->
match class_type_np with Sil.tenv_add tenv named_type struct_typ;
| Sil.Tstruct struct_typ -> typ
Sil.tenv_add tenv named_type struct_typ; | _ -> assert false)
class_type_np | Some struct_typ -> Sil.Tstruct struct_typ
| _ -> assert false
let get_class_type program tenv cn = let get_class_type program tenv cn =
let t = get_class_type_no_pointer program tenv cn in let t = get_class_type_no_pointer program tenv cn in

Write Preview
Loading…
Cancel
Save