From 337d2cc537f9386f6d2cd36ffb05841dcea92b92 Mon Sep 17 00:00:00 2001 From: Sam Blackshear Date: Tue, 1 Mar 2016 10:12:11 -0800 Subject: [PATCH] fixing tenv_add to add only struct_typ's Reviewed By: akotulski Differential Revision: D2988324 fb-gh-sync-id: b6093d1 shipit-source-id: b6093d1 --- infer/src/backend/sil.ml | 6 ++---- infer/src/backend/sil.mli | 2 +- infer/src/clang/cField_decl.ml | 14 +++++++------- infer/src/clang/cFrontend_utils.ml | 2 +- infer/src/clang/cTrans.ml | 22 ++++++++++++---------- infer/src/clang/cTypes_decl.ml | 10 +++++----- infer/src/clang/objcCategory_decl.ml | 15 ++++++++------- infer/src/clang/objcInterface_decl.ml | 9 +++------ infer/src/clang/objcProtocol_decl.ml | 2 +- infer/src/harness/harness.ml | 7 ++++--- infer/src/java/jTransType.ml | 10 ++++++---- 11 files changed, 50 insertions(+), 49 deletions(-) diff --git a/infer/src/backend/sil.ml b/infer/src/backend/sil.ml index 52dd2f048..0f8a6b2e0 100644 --- a/infer/src/backend/sil.ml +++ b/infer/src/backend/sil.ml @@ -3774,10 +3774,8 @@ let tenv_lookup tenv name = with Not_found -> None (** Add a (name,type) pair to the global type environment. *) -let tenv_add tenv name typ = - match typ with - | Tstruct struct_typ -> TypenameHash.replace tenv name struct_typ - | _ -> assert false +let tenv_add tenv name struct_typ = + TypenameHash.replace tenv name struct_typ (** expand a type if it is a typename by looking it up in the type environment *) let expand_type tenv typ = diff --git a/infer/src/backend/sil.mli b/infer/src/backend/sil.mli index 2715db000..b920e8d3f 100644 --- a/infer/src/backend/sil.mli +++ b/infer/src/backend/sil.mli @@ -525,7 +525,7 @@ val tenv_mem : tenv -> Typename.t -> bool val tenv_lookup : tenv -> Typename.t -> typ option (** Add a (name,typ) pair to the global type environment. *) -val tenv_add : tenv -> Typename.t -> typ -> unit +val tenv_add : tenv -> Typename.t -> struct_typ -> unit (** expand a type if it is a typename by looking it up in the type environment *) val expand_type : tenv -> typ -> typ diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index 71eb576f0..ac0754d46 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -81,13 +81,13 @@ let add_missing_fields tenv class_name ck fields = | Some Sil.Tstruct ({ Sil.instance_fields } as struct_typ) -> let new_fields = General_utils.append_no_duplicates_fields instance_fields fields in let class_type_info = - Sil.Tstruct - { struct_typ with - Sil.instance_fields = new_fields; - static_fields = []; - csu = Csu.Class ck; - struct_name = Some mang_name; - } in + { + struct_typ with + Sil.instance_fields = new_fields; + static_fields = []; + csu = Csu.Class ck; + struct_name = Some mang_name; + } in Printing.log_out " Updating info for class '%s' in tenv\n" class_name; Sil.tenv_add tenv class_tn_name class_type_info | _ -> () diff --git a/infer/src/clang/cFrontend_utils.ml b/infer/src/clang/cFrontend_utils.ml index 43e9b0443..927ee128f 100644 --- a/infer/src/clang/cFrontend_utils.ml +++ b/infer/src/clang/cFrontend_utils.ml @@ -462,7 +462,7 @@ struct let sort_fields_tenv tenv = let sort_fields_struct typname st = let st' = { st with Sil.instance_fields = (sort_fields st.Sil.instance_fields) } in - Sil.tenv_add tenv typname (Sil.Tstruct st') in + Sil.tenv_add tenv typname st' in Sil.tenv_iter sort_fields_struct tenv let rec collect_list_tuples l (a, a1, b, c, d) = diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index cda0cb3a0..9caed8080 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -116,17 +116,19 @@ 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_type = Sil.Tstruct - { Sil.instance_fields = fields; - static_fields = []; - csu = Csu.Class Csu.Objc; - struct_name = Some mblock; - superclasses = []; - def_methods = []; - struct_annotations = []; - } in + let block_struct_typ = + { + Sil.instance_fields = fields; + static_fields = []; + csu = Csu.Class Csu.Objc; + struct_name = Some mblock; + superclasses = []; + def_methods = []; + struct_annotations = []; + } in + let block_type = Sil.Tstruct block_struct_typ in let block_name = Typename.TN_csu (Csu.Class Csu.Objc, mblock) in - Sil.tenv_add tenv block_name block_type; + Sil.tenv_add tenv block_name block_struct_typ; 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 | [(Sil.Var id, _)] -> id diff --git a/infer/src/clang/cTypes_decl.ml b/infer/src/clang/cTypes_decl.ml index ef4ca2ca1..60aa1d4b0 100644 --- a/infer/src/clang/cTypes_decl.ml +++ b/infer/src/clang/cTypes_decl.ml @@ -16,7 +16,7 @@ module L = Logging let add_predefined_objc_types tenv = let class_typename = CType_to_sil_type.get_builtin_objc_typename `ObjCClass in let objc_class_type_info = - Sil.Tstruct { + { Sil.instance_fields = []; static_fields = []; csu = Csu.Struct; @@ -28,7 +28,7 @@ let add_predefined_objc_types tenv = Sil.tenv_add tenv class_typename objc_class_type_info; let id_typename = CType_to_sil_type.get_builtin_objc_typename `ObjCId in let objc_object_type_info = - Sil.Tstruct { + { Sil.instance_fields = []; static_fields = []; csu = Csu.Struct; @@ -137,12 +137,12 @@ let get_superclass_list_cpp decl = IList.map get_super_field base_decls let add_struct_to_tenv tenv typ = - let csu = match typ with - | Sil.Tstruct { Sil.csu } -> csu + let csu, struct_typ = match typ with + | Sil.Tstruct ({ Sil.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 - Sil.tenv_add tenv typename typ + Sil.tenv_add tenv typename struct_typ let rec get_struct_fields tenv decl = let open Clang_ast_t in diff --git a/infer/src/clang/objcCategory_decl.ml b/infer/src/clang/objcCategory_decl.ml index 8aaa9b8e3..7c646e043 100644 --- a/infer/src/clang/objcCategory_decl.ml +++ b/infer/src/clang/objcCategory_decl.ml @@ -82,13 +82,14 @@ let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list = 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 = - Sil.Tstruct { struct_typ with - Sil.instance_fields = new_fields; - static_fields = []; - csu = Csu.Class Csu.Objc; - struct_name = Some mang_name; - def_methods = new_methods; - } in + { + struct_typ with + Sil.instance_fields = new_fields; + static_fields = []; + csu = Csu.Class Csu.Objc; + struct_name = Some mang_name; + def_methods = new_methods; + } in Printing.log_out " Updating info for class '%s' in tenv\n" class_name; Sil.tenv_add tenv class_tn_name class_type_info | _ -> ()); diff --git a/infer/src/clang/objcInterface_decl.ml b/infer/src/clang/objcInterface_decl.ml index b0db5099a..3b49fc72b 100644 --- a/infer/src/clang/objcInterface_decl.ml +++ b/infer/src/clang/objcInterface_decl.ml @@ -125,7 +125,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name IList.iter (fun (fn, _, _) -> Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; let interface_type_info = - Sil.Tstruct { + { Sil.instance_fields = fields; static_fields = []; csu = Csu.Class Csu.Objc; @@ -155,11 +155,8 @@ let add_missing_methods tenv class_name ck decl_info decl_list curr_class = def_methods; } as struct_typ) -> let methods = General_utils.append_no_duplicates_methods def_methods methods in - let typ = - Sil.Tstruct - { struct_typ with - Sil.def_methods = methods; } in - Sil.tenv_add tenv class_tn_name typ + let struct_typ' = { struct_typ with Sil.def_methods = methods; } in + Sil.tenv_add tenv class_tn_name struct_typ' | _ -> ()); Sil.Tvar class_tn_name diff --git a/infer/src/clang/objcProtocol_decl.ml b/infer/src/clang/objcProtocol_decl.ml index f1ba2987d..da3aa2f97 100644 --- a/infer/src/clang/objcProtocol_decl.ml +++ b/infer/src/clang/objcProtocol_decl.ml @@ -32,7 +32,7 @@ let protocol_decl type_ptr_to_sil_type tenv decl = Ast_utils.update_sil_types_map decl_key (Sil.Tvar protocol_name); let def_methods = ObjcProperty_decl.get_methods curr_class decl_list in let protocol_type_info = - Sil.Tstruct { + { Sil.instance_fields = []; static_fields = []; csu = Csu.Protocol; diff --git a/infer/src/harness/harness.ml b/infer/src/harness/harness.ml index d516bd5b9..8356577b9 100644 --- a/infer/src/harness/harness.ml +++ b/infer/src/harness/harness.ml @@ -140,8 +140,8 @@ let extract_callbacks lifecycle_trace harness_procname proc_file_map tenv = find_registered_callbacks lifecycle_trace harness_name proc_file_map tenv in let fields = IList.map (fun (fld, typ, _) -> (fld, typ, [])) registered_cbs in (* create a new typ for the harness containing all of the cb extraction vars as static fields *) - let harness_typ = - Sil.Tstruct { + let harness_struct_typ = + { Sil.instance_fields = fields; static_fields = []; csu = Csu.Class Csu.Java; @@ -150,10 +150,11 @@ let extract_callbacks lifecycle_trace harness_procname proc_file_map tenv = def_methods = [harness_procname]; struct_annotations = []; } in + let harness_typ = Sil.Tstruct harness_struct_typ 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 Csu.Java, harness_name) in - Sil.tenv_add tenv harness_class harness_typ; + Sil.tenv_add tenv harness_class harness_struct_typ; let cfgs_to_save = IList.fold_left (fun cfgs_to_save (_, _, instrument_sil_f) -> (* instrument the cfg's with callback extraction code *) diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 5a51690f2..70e3e90ab 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -356,9 +356,11 @@ and get_class_type_no_pointer program tenv cn = match Sil.tenv_lookup tenv named_type with | None -> create_sil_type program tenv cn | Some t -> t in - Sil.tenv_add tenv named_type class_type_np; - class_type_np - + match class_type_np with + | Sil.Tstruct struct_typ -> + Sil.tenv_add tenv named_type struct_typ; + class_type_np + | _ -> assert false let get_class_type program tenv cn = let t = get_class_type_no_pointer program tenv cn in @@ -467,7 +469,7 @@ let return_type program tenv ms meth_kind = let add_models_types tenv = let add_type t typename struct_typ = if not (Sil.tenv_mem t typename) then - Sil.tenv_add tenv typename (Sil.Tstruct struct_typ) in + Sil.tenv_add tenv typename struct_typ in Sil.tenv_iter (add_type tenv) !JClasspath.models_tenv