fixing tenv_lookup

Reviewed By: cristianoc

Differential Revision: D2991693

fb-gh-sync-id: 3139630
shipit-source-id: 3139630

infer/src/backend/abs.ml

@@ -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

infer/src/backend/prop.ml

@@ -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 ->
+  | 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
 
 (** Sil.Construct a pointsto. *)

infer/src/backend/prover.ml

@@ -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

infer/src/backend/sil.ml

@@ -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
 

infer/src/backend/sil.mli

@@ -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

infer/src/backend/symExec.ml

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

infer/src/checkers/callbackChecker.ml

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

infer/src/checkers/fragmentRetainsViewChecker.ml

@@ -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 }
+      | 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 =
             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

infer/src/checkers/patternMatch.ml

@@ -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 ->
+    | 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 -> ()
 
 (** return the set of instance fields that are assigned to a null literal in [procdesc] *)

infer/src/checkers/performanceCritical.ml

@@ -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
 

infer/src/clang/cContext.ml

@@ -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 ->

infer/src/clang/cField_decl.ml

@@ -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 { Sil.instance_fields } -> instance_fields
-  | Some _ -> []
 
 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 =
         {

infer/src/clang/cFrontend_checkers.ml

@@ -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.

infer/src/clang/cMethod_trans.ml

@@ -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);

infer/src/clang/cTrans.ml

@@ -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 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.*))
       | Sil.Tstruct { Sil.instance_fields } as type_struct ->
           let lh_exprs = IList.map ( fun (fieldname, _, _) ->

infer/src/clang/cTypes.ml

@@ -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

infer/src/clang/cTypes_decl.ml

@@ -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 *)

infer/src/clang/objcCategory_decl.ml

@@ -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
+   | 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_methods = General_utils.append_no_duplicates_methods methods def_methods in
        let class_type_info =

infer/src/clang/objcInterface_decl.ml

@@ -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,9 +147,9 @@ 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
+  begin
-   | Some Sil.Tstruct
+    match Sil.tenv_lookup tenv class_tn_name with
-       ({ Sil.static_fields = [];
+    | Some ({ Sil.static_fields = [];
               csu = Csu.Class _;
               struct_name = Some _;
               def_methods;
@@ -157,7 +157,8 @@ let add_missing_methods tenv class_name ck decl_info decl_list curr_class =
         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. *)

infer/src/harness/androidFramework.ml

@@ -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
+  | 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 *)
       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
 
 

infer/src/java/jTransType.ml

@@ -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
+  | None ->
-    | Some t -> t in
+      (match create_sil_type program tenv cn with
-  match class_type_np with
+       | (Sil.Tstruct struct_typ) as typ->
-  | Sil.Tstruct struct_typ ->
            Sil.tenv_add tenv named_type struct_typ;
-      class_type_np
+           typ
-  | _ -> assert false
+       | _ -> 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