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

@@ -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 =
+let tenv_add tenv name struct_typ =
-  match typ with
+  TypenameHash.replace tenv name struct_typ
-  | Tstruct struct_typ -> TypenameHash.replace tenv name struct_typ
-  | _ -> assert false
 
 (** expand a type if it is a typename by looking it up in the type environment *)
 let expand_type tenv typ =

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

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
+          struct_typ with
-            Sil.instance_fields = new_fields;
+          Sil.instance_fields = new_fields;
-            static_fields = [];
+          static_fields = [];
-            csu = Csu.Class ck;
+          csu = Csu.Class ck;
-            struct_name = Some mang_name;
+          struct_name = Some mang_name;
-          } in
+        } in
       Printing.log_out " Updating info for class '%s' in tenv\n" class_name;
       Sil.tenv_add tenv class_tn_name class_type_info
   | _ -> ()

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

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
+    let block_struct_typ =
-        { Sil.instance_fields = fields;
+      {
-          static_fields = [];
+        Sil.instance_fields = fields;
-          csu = Csu.Class Csu.Objc;
+        static_fields = [];
-          struct_name = Some mblock;
+        csu = Csu.Class Csu.Objc;
-          superclasses = [];
+        struct_name = Some mblock;
-          def_methods = [];
+        superclasses = [];
-          struct_annotations = [];
+        def_methods = [];
-        } in
+        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

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
+  let csu, struct_typ = match typ with
-    | Sil.Tstruct { Sil.csu } -> csu
+    | 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

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;
+           struct_typ with
-                       static_fields = [];
+           Sil.instance_fields = new_fields;
-                       csu = Csu.Class Csu.Objc;
+           static_fields = [];
-                       struct_name = Some mang_name;
+           csu = Csu.Class Csu.Objc;
-                       def_methods = new_methods;
+           struct_name = Some mang_name;
-                     } in
+           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
    | _ -> ());

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 =
+       let struct_typ' = { struct_typ with Sil.def_methods = methods; } in
-         Sil.Tstruct
+       Sil.tenv_add tenv class_tn_name struct_typ'
-           { struct_typ with
-             Sil.def_methods = methods; } in
-       Sil.tenv_add tenv class_tn_name typ
    | _ -> ());
   Sil.Tvar class_tn_name
 

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;

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 =
+  let harness_struct_typ =
-    Sil.Tstruct {
+    {
       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 *)

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;
+  match class_type_np with
-  class_type_np
+  | 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