fixing tenv_lookup

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

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

@ -1106,19 +1106,7 @@ let rec create_strexp_of_type tenvo struct_init_mode typ inst =
end
| Sil.Tarray (_, size) ->
Sil.Earray (size, [], inst)
| Sil.Tvar name ->
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;
| Sil.Tvar _ ->
assert false
(** Sil.Construct a pointsto. *)

@ -1454,7 +1454,7 @@ struct
let is_interface tenv class_name =
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.def_methods = 0)
| _ -> false
@ -1472,7 +1472,7 @@ struct
let rec check cn =
Typename.equal cn c2 || is_root_class c2 ||
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
| _ -> false in
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
| Some typ -> typ
| 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
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
@ -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
| Some typ -> typ
| 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
try
(match move_primed_lhs_from_front subs sigma2 with

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

@ -522,7 +522,7 @@ val create_tenv : unit -> tenv
val tenv_mem : tenv -> Typename.t -> bool
(** 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. *)
val tenv_add : tenv -> Typename.t -> struct_typ -> unit

@ -547,7 +547,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.csu = Csu.Class _; def_methods; superclasses } ->
if method_exists right_proc_name def_methods then
Some right_proc_name
else
@ -601,7 +601,7 @@ let lookup_java_typ_from_string tenv 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
| Some struct_typ -> Sil.Tstruct struct_typ
| _ -> raise (Cannot_convert_string_to_typ typ_str) in
loop typ_str
@ -772,30 +772,6 @@ let redirect_shared_ptr tenv cfg pname actual_params =
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
to be only the protocol. *)
let call_constructor_url_update_args pname actual_params =

@ -67,7 +67,8 @@ let callback_checker_main
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 { 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 proc_belongs_to_lifecycle_typ = IList.exists
(fun lifecycle_typ -> AndroidFramework.typ_is_lifecycle_typ typ lifecycle_typ tenv)

@ -27,7 +27,7 @@ let callback_fragment_retains_view { Callbacks.proc_desc; proc_name; tenv } =
| Sil.Tptr (Sil.Tvar tname, _) ->
begin
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
end
| _ -> false in
@ -39,8 +39,8 @@ let callback_fragment_retains_view { Callbacks.proc_desc; proc_name; tenv } =
begin
let class_typename = Typename.Java.from_string (Procname.java_get_class proc_name) in
match Sil.tenv_lookup tenv class_typename with
| Some (Sil.Tstruct { Sil.struct_name = Some _; instance_fields }
as typ) when AndroidFramework.is_fragment typ tenv ->
| Some ({ Sil.struct_name = Some _; instance_fields } as struct_typ)
when AndroidFramework.is_fragment (Sil.Tstruct struct_typ) tenv ->
let declared_view_fields =
IList.filter (is_declared_view_typ class_typename) instance_fields 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
(fun (fname, fld_typ, _) ->
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
| _ -> ()
end

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

@ -87,7 +87,8 @@ let is_modeled_expensive tenv pname =
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
| None -> false
| Some typ ->
| Some struct_typ ->
let typ = Sil.Tstruct struct_typ in
AndroidFramework.is_view typ tenv
|| AndroidFramework.is_activity typ tenv

@ -117,7 +117,7 @@ let curr_class_hash curr_class =
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 } ->
| Some { Sil.superclasses } ->
(let superclasses_names = IList.map Typename.name superclasses in
match superclasses_names with
| superclass:: protocols ->

@ -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);
match Sil.tenv_lookup tenv super_class with
| 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
General_utils.append_no_duplicates_fields instance_fields sc_fields
| Some Sil.Tstruct { Sil.instance_fields } -> instance_fields
| Some _ -> []
| Some { Sil.instance_fields } -> instance_fields
let fields_superclass tenv interface_decl_info ck =
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 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) ->
| Some ({ Sil.instance_fields } as struct_typ) ->
let new_fields = General_utils.append_no_duplicates_fields instance_fields fields in
let class_type_info =
{

@ -69,7 +69,7 @@ let direct_atomic_property_access_warning context stmt_info ivar_name =
| _ -> Ident.create_fieldname (Mangled.from_string "") 0, "" in
let tname = Typename.TN_csu (Csu.Class Csu.Objc, Mangled.from_string cname) in
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:
(1) the property has the atomic attribute and
(2) the access of the ivar is not in a getter or setter method.

@ -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
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 :: _ } ->
| Some { Sil.superclasses = super_name :: _ } ->
Typename.name super_name
| _ ->
Printing.log_err "NOT FOUND superclass = '%s'\n\n%!" (Typename.to_string iname);

@ -1525,12 +1525,7 @@ struct
match typ with
| Sil.Tvar tn ->
(match Sil.tenv_lookup context.CContext.tenv tn with
| Some (Sil.Tstruct _ as str) -> collect_left_hand_exprs e str 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)
| Some struct_typ -> collect_left_hand_exprs e (Sil.Tstruct struct_typ) tns
| _ -> [[(e, typ)]] (*This case is an error, shouldn't happen.*))
| Sil.Tstruct { Sil.instance_fields } as type_struct ->
let lh_exprs = IList.map ( fun (fieldname, _, _) ->

@ -86,7 +86,8 @@ let rec expand_structured_type tenv typ =
match typ with
| Sil.Tvar tn ->
(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);
if Sil.typ_equal t typ then
typ

@ -201,7 +201,7 @@ and get_struct_cpp_class_declaration_type tenv decl =
sil_type
) else (
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 ->
(* 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 *)

@ -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
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.instance_fields; def_methods }
as struct_typ) ->
| Some ({ Sil.instance_fields; def_methods } as struct_typ) ->
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 class_type_info =

@ -22,7 +22,7 @@ let is_pointer_to_objc_class tenv typ =
match typ 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
| Some struct_typ when Sil.is_objc_class (Sil.Tstruct struct_typ) -> true
| _ -> false)
| Sil.Tptr (typ, _) when Sil.is_objc_class typ -> true
| _ -> 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 *)
let fields, (superclasses : Typename.t list), methods =
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_csu superclasses superclasses,
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
" >>>Verifying that Typename '%s' is in tenv\n" (Typename.to_string interface_name);
(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");
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 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 _;
struct_name = Some _;
def_methods;
} as struct_typ) ->
let methods = General_utils.append_no_duplicates_methods def_methods methods in
let struct_typ' = { struct_typ with Sil.def_methods = methods; } in
Sil.tenv_add tenv class_tn_name struct_typ'
| _ -> ());
begin
match Sil.tenv_lookup tenv class_tn_name with
| Some ({ Sil.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
let struct_typ' = { struct_typ with Sil.def_methods = methods; } in
Sil.tenv_add tenv class_tn_name struct_typ'
| _ -> ()
end;
Sil.Tvar class_tn_name
(* Interface_type_info has the name of instance variables and the name of methods. *)

@ -256,7 +256,9 @@ let get_all_supertypes typ tenv =
| _ -> [] in
let rec add_typ class_name typs =
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
and get_supers_rec typ all_supers =
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 classname = Mangled.from_package_class package classname in
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
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 *)
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
| Some (Sil.Tstruct
{ Sil.csu = Csu.Class _; struct_name = Some _; def_methods } as lifecycle_typ) ->
| Some ({ 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 ->
@ -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
with Not_found -> lifecycle_procs)
[] lifecycle_proc_strs in
Some (lifecycle_typ, lifecycle_procs)
Some (Sil.Tstruct lifecycle_typ, lifecycle_procs)
| _ -> None
(** 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
match lookup cn1, lookup typename with
| Some typ1, Some typ2 ->
is_subtype typ1 typ2 tenv
is_subtype (Sil.Tstruct typ1) (Sil.Tstruct typ2) tenv
| _ -> false

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

Loading…
Cancel
Save