From 4143d4eb2d05dfd03fde874012852d131154c959 Mon Sep 17 00:00:00 2001 From: jrm Date: Fri, 18 Dec 2015 11:50:46 -0800 Subject: [PATCH] Extract the kind of data structure, Class Struct or Union, into it own module Summary: public Move the representation of data-structure into it own module, so that it can be used by modules `Sil` depends from like `Procname`. Reviewed By: jberdine Differential Revision: D2772791 fb-gh-sync-id: cda4e3a --- infer/src/backend/autounit.ml | 3 +- infer/src/backend/csu.ml | 42 ++++++++++++++ infer/src/backend/csu.mli | 24 ++++++++ infer/src/backend/localise.ml | 2 +- infer/src/backend/prop.ml | 15 +++-- infer/src/backend/prover.ml | 31 +++++++---- infer/src/backend/rearrange.ml | 13 +++-- infer/src/backend/sil.ml | 68 +++++++---------------- infer/src/backend/sil.mli | 23 +++----- infer/src/backend/symExec.ml | 32 +++++++---- infer/src/backend/tabulation.ml | 3 +- infer/src/backend/type_prop.ml | 10 ++-- infer/src/checkers/callbackChecker.ml | 2 +- infer/src/checkers/eradicateChecks.ml | 2 +- infer/src/checkers/patternMatch.ml | 25 +++++---- infer/src/checkers/patternMatch.mli | 6 +- infer/src/checkers/performanceCritical.ml | 2 +- infer/src/clang/cContext.ml | 2 +- infer/src/clang/cField_decl.ml | 8 +-- infer/src/clang/cFrontend_checkers.ml | 2 +- infer/src/clang/cFrontend_utils.ml | 9 ++- infer/src/clang/cFrontend_utils.mli | 3 +- infer/src/clang/cMethod_trans.ml | 2 +- infer/src/clang/cTrans.ml | 4 +- infer/src/clang/cType_to_sil_type.ml | 4 +- infer/src/clang/cTypes.ml | 4 +- infer/src/clang/cTypes_decl.ml | 30 +++++----- infer/src/clang/objcCategory_decl.ml | 4 +- infer/src/clang/objcInterface_decl.ml | 22 ++++---- infer/src/clang/objcProtocol_decl.ml | 4 +- infer/src/harness/androidFramework.ml | 12 ++-- infer/src/harness/harness.ml | 6 +- infer/src/harness/inhabit.ml | 4 +- infer/src/harness/stacktrace.ml | 4 +- infer/src/java/jTrans.ml | 2 +- infer/src/java/jTransType.ml | 16 ++++-- 36 files changed, 259 insertions(+), 186 deletions(-) create mode 100644 infer/src/backend/csu.ml create mode 100644 infer/src/backend/csu.mli diff --git a/infer/src/backend/autounit.ml b/infer/src/backend/autounit.ml index 475aac491..e8533ee17 100644 --- a/infer/src/backend/autounit.ml +++ b/infer/src/backend/autounit.ml @@ -420,7 +420,8 @@ let pp_texp_for_malloc fmt = | Sil.Tptr (t, pk) -> Sil.Tptr (handle_arr_size t, pk) | Sil.Tstruct (ftal, sftal, csu, nameo, supers, def_mthds, iann) -> - Sil.Tstruct (IList.map (fun (f, t, a) -> (f, handle_arr_size t, a)) ftal, sftal, csu, nameo, supers, def_mthds, iann) + Sil.Tstruct (IList.map (fun (f, t, a) -> + (f, handle_arr_size t, a)) ftal, sftal, csu, nameo, supers, def_mthds, iann) | Sil.Tarray (t, e) -> Sil.Tarray (handle_arr_size t, e) in function diff --git a/infer/src/backend/csu.ml b/infer/src/backend/csu.ml new file mode 100644 index 000000000..719eb3c3f --- /dev/null +++ b/infer/src/backend/csu.ml @@ -0,0 +1,42 @@ +(* + * Copyright (c) 2015 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +open Utils + +(** Internal representation of data structure for Java, Objective-C and C++ classes, + C-style structs struct and union, + And Objective C protocol *) + +type t = + | Class + | Struct + | Union + | Protocol + +let name = function + | Class -> "class" + | Struct -> "struct" + | Union -> "union" + | Protocol -> "protocol" + +let compare dstruct1 dstruct2 = + match dstruct1, dstruct2 with + | Class, Class -> 0 + | Class, _ -> -1 + | _, Class -> 1 + | Struct, Struct -> 0 + | Struct, _ -> -1 + | _, Struct -> 1 + | Union, Union -> 0 + | Union, _ -> -1 + | _, Union -> 1 + | Protocol, Protocol -> 0 + +let equal tn1 tn2 = + compare tn1 tn2 = 0 diff --git a/infer/src/backend/csu.mli b/infer/src/backend/csu.mli new file mode 100644 index 000000000..6b1adcb00 --- /dev/null +++ b/infer/src/backend/csu.mli @@ -0,0 +1,24 @@ +(* + * Copyright (c) 2015 - present Facebook, Inc. + * All rights reserved. + * + * This source code is licensed under the BSD style license found in the + * LICENSE file in the root directory of this source tree. An additional grant + * of patent rights can be found in the PATENTS file in the same directory. + *) + +(** Internal representation of data structure for Java, Objective-C and C++ classes, + C-style structs struct and union, + And Objective C protocol *) + +type t = + | Class + | Struct + | Union + | Protocol + +val name : t -> string + +val compare : t -> t -> int + +val equal : t -> t -> bool diff --git a/infer/src/backend/localise.ml b/infer/src/backend/localise.ml index aa9ca80dc..2a751d952 100644 --- a/infer/src/backend/localise.ml +++ b/infer/src/backend/localise.ml @@ -597,7 +597,7 @@ let desc_leak hpred_type_opt value_str_opt resource_opt resource_action_opt loc s, " to ", " on " in let typ_str = match hpred_type_opt with - | Some (Sil.Sizeof (Sil.Tstruct (_, _, Sil.Class, Some classname, _, _, _), _)) + | Some (Sil.Sizeof (Sil.Tstruct (_, _, Csu.Class, Some classname, _, _, _), _)) when !Config.curr_language = Config.Java -> " of type " ^ Mangled.to_string classname ^ " " | _ -> " " in diff --git a/infer/src/backend/prop.ml b/infer/src/backend/prop.ml index 69bb7c8fa..984dae0ca 100644 --- a/infer/src/backend/prop.ml +++ b/infer/src/backend/prop.ml @@ -596,16 +596,23 @@ let sym_eval abs e = (* progress: convert inner +I to +A *) let e2' = Sil.BinOp (Sil.PlusA, e12, e2) in eval (Sil.BinOp (Sil.PlusPI, e11, e2')) - | Sil.BinOp (Sil.PlusA, (Sil.Sizeof (Sil.Tstruct (ftal, sftal, csu, name_opt, supers, def_mthds, iann), st) as e1), e2) -> (* pattern for extensible structs - given a struct declatead as struct s { ... t arr[n] ... }, allocation pattern malloc(sizeof(struct s) + k * siezof(t)) - turn it into struct s { ... t arr[n + k] ... } *) + | Sil.BinOp + (Sil.PlusA, + (Sil.Sizeof + (Sil.Tstruct (ftal, sftal, csu, name_opt, supers, def_mthds, iann), st) as e1), + e2) -> + (* pattern for extensible structs given a struct declatead as struct s { ... t arr[n] ... }, + allocation pattern malloc(sizeof(struct s) + k * siezof(t)) turn it into + struct s { ... t arr[n + k] ... } *) let e1' = eval e1 in let e2' = eval e2 in (match IList.rev ftal, e2' with (fname, Sil.Tarray(typ, size), _):: ltfa, Sil.BinOp(Sil.Mult, num_elem, Sil.Sizeof (texp, st)) when ftal != [] && Sil.typ_equal typ texp -> let size' = Sil.BinOp(Sil.PlusA, size, num_elem) in let ltfa' = (fname, Sil.Tarray(typ, size'), Sil.item_annotation_empty) :: ltfa in - Sil.Sizeof(Sil.Tstruct (IList.rev ltfa', sftal, csu, name_opt, supers, def_mthds, iann), st) + Sil.Sizeof + (Sil.Tstruct + (IList.rev ltfa', sftal, csu, name_opt, supers, def_mthds, iann), st) | _ -> Sil.BinOp(Sil.PlusA, e1', e2')) | Sil.BinOp (Sil.PlusA as oplus, e1, e2) | Sil.BinOp (Sil.PlusPI as oplus, e1, e2) -> diff --git a/infer/src/backend/prover.ml b/infer/src/backend/prover.ml index 0fd2acb5f..c6fffbb60 100644 --- a/infer/src/backend/prover.ml +++ b/infer/src/backend/prover.ml @@ -1415,7 +1415,11 @@ let expand_hpred_pointer calc_index_frame hpred : bool * bool * Sil.hpred = | _, Sil.Tstruct _ -> (* the struct type of fld is known *) Sil.Sizeof (typ_fld, Sil.Subtype.exact) | Sil.Sizeof (_t, st), _ -> (* the struct type of fld is not known -- typically Tvoid *) - Sil.Sizeof (Sil.Tstruct ([(fld, _t, Sil.item_annotation_empty)], [], Sil.Struct, None, [], [], Sil.item_annotation_empty), st) (* None as we don't know the stuct name *) + Sil.Sizeof + (Sil.Tstruct + ([(fld, _t, Sil.item_annotation_empty)], + [], Csu.Struct, None, [], [], Sil.item_annotation_empty), st) + (* None as we don't know the stuct name *) | _ -> raise (Failure "expand_hpred_pointer: Unexpected non-sizeof type in Lfield") in let hpred' = Sil.Hpointsto (e, Sil.Estruct ([(fld, se)], Sil.inst_none), t') in expand true true hpred' @@ -1443,8 +1447,8 @@ let serializable_type = Mangled.from_string "java.io.Serializable" let cloneable_type = Mangled.from_string "java.lang.Cloneable" let is_interface tenv c = - match Sil.tenv_lookup tenv (Sil.TN_csu (Sil.Class, c)) with - | Some (Sil.Tstruct (fields, sfields, Sil.Class, Some c1', supers1, methods, iann)) -> + match Sil.tenv_lookup tenv (Sil.TN_csu (Csu.Class, c)) with + | Some (Sil.Tstruct (fields, sfields, Csu.Class, Some c1', supers1, methods, iann)) -> (IList.length fields = 0) && (IList.length methods = 0) | _ -> false @@ -1452,11 +1456,11 @@ let is_interface tenv c = let check_subclass_tenv tenv c1 c2 = let rec check (_, c) = Mangled.equal c c2 || (Mangled.equal c2 object_type) || - match Sil.tenv_lookup tenv (Sil.TN_csu (Sil.Class, c)) with - | Some (Sil.Tstruct (_, _, Sil.Class, Some c1', supers1, _, _)) -> + match Sil.tenv_lookup tenv (Sil.TN_csu (Csu.Class, c)) with + | Some (Sil.Tstruct (_, _, Csu.Class, Some c1', supers1, _, _)) -> IList.exists check supers1 | _ -> false in - (check (Sil.Class, c1)) + (check (Csu.Class, c1)) let check_subclass tenv c1 c2 = let f = check_subclass_tenv tenv in @@ -1474,7 +1478,8 @@ let check_subtype_basic_type t1 t2 = (** check if t1 is a subtype of t2 *) let rec check_subtype tenv t1 t2 = match t1, t2 with - | Sil.Tstruct (_, _, Sil.Class, Some c1, _, _, _), Sil.Tstruct (_, _, Sil.Class, Some c2, _, _, _) -> + | Sil.Tstruct (_, _, Csu.Class, Some c1, _, _, _), + Sil.Tstruct (_, _, Csu.Class, Some c2, _, _, _) -> (check_subclass tenv c1 c2) | Sil.Tarray (dom_type1, _), Sil.Tarray (dom_type2, _) -> @@ -1483,14 +1488,15 @@ let rec check_subtype tenv t1 t2 = | Sil.Tptr (dom_type1, _), Sil.Tptr (dom_type2, _) -> check_subtype tenv dom_type1 dom_type2 - | Sil.Tarray _, Sil.Tstruct (_, _, Sil.Class, Some c2, _, _, _) -> + | Sil.Tarray _, Sil.Tstruct (_, _, Csu.Class, Some c2, _, _, _) -> (Mangled.equal c2 serializable_type) || (Mangled.equal c2 cloneable_type) || (Mangled.equal c2 object_type) | _ -> (check_subtype_basic_type t1 t2) let rec case_analysis_type tenv (t1, st1) (t2, st2) = match t1, t2 with - | Sil.Tstruct (_, _, Sil.Class, Some c1, _, _, _), Sil.Tstruct (_, _, Sil.Class, Some c2, _, _, _) -> + | Sil.Tstruct (_, _, Csu.Class, Some c1, _, _, _), + Sil.Tstruct (_, _, Csu.Class, Some c2, _, _, _) -> (Sil.Subtype.case_analysis (c1, st1) (c2, st2) (check_subclass tenv) (is_interface tenv)) | Sil.Tarray (dom_type1, _), Sil.Tarray (dom_type2, _) -> @@ -1499,7 +1505,7 @@ let rec case_analysis_type tenv (t1, st1) (t2, st2) = | Sil.Tptr (dom_type1, _), Sil.Tptr (dom_type2, _) -> (case_analysis_type tenv (dom_type1, st1) (dom_type2, st2)) - | Sil.Tstruct (_, _, Sil.Class, Some c1, _, _, _), Sil.Tarray _ -> + | Sil.Tstruct (_, _, Csu.Class, Some c1, _, _, _), Sil.Tarray _ -> if ((Mangled.equal c1 serializable_type) || (Mangled.equal c1 cloneable_type) || (Mangled.equal c1 object_type)) && (st1 <> Sil.Subtype.exact) then (Some st1, None) else (None, Some st1) @@ -1845,7 +1851,8 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 * match !Config.curr_language with | Config.C_CPP -> Sil.Sizeof (Sil.Tarray (Sil.Tint Sil.IChar, size), Sil.Subtype.exact) | Config.Java -> - let object_type = Sil.TN_csu (Sil.Class, Mangled.from_string "java.lang.String") in + let object_type = + Sil.TN_csu (Csu.Class, Mangled.from_string "java.lang.String") in let typ = match Sil.tenv_lookup tenv object_type with | Some typ -> typ | None -> assert false in @@ -1856,7 +1863,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : (subst2 * let sexp = (* TODO: add appropriate fields *) Sil.Estruct ([(Ident.create_fieldname (Mangled.from_string "java.lang.Class.name") 0, Sil.Eexp ((Sil.Const (Sil.Cstr s), Sil.Inone)))], Sil.inst_none) in let class_texp = - let class_type = Sil.TN_csu (Sil.Class, Mangled.from_string "java.lang.Class") in + let class_type = Sil.TN_csu (Csu.Class, Mangled.from_string "java.lang.Class") in let typ = match Sil.tenv_lookup tenv class_type with | Some typ -> typ | None -> assert false in diff --git a/infer/src/backend/rearrange.ml b/infer/src/backend/rearrange.ml index 608ac1821..794fcbe5f 100644 --- a/infer/src/backend/rearrange.ml +++ b/infer/src/backend/rearrange.ml @@ -104,7 +104,8 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp match t, off with | Sil.Tstruct (ftal, sftal, _, _, _, _, _),[] -> ([], Sil.Estruct ([], inst), t) - | Sil.Tstruct (ftal, sftal, csu, nameo, supers, def_mthds, iann), (Sil.Off_fld (f, _)):: off' -> + | Sil.Tstruct (ftal, sftal, csu, nameo, supers, def_mthds, iann), + (Sil.Off_fld (f, _)):: off' -> let _, t', _ = try IList.find (fun (f', _, _) -> Ident.fieldname_equal f f') ftal with Not_found -> raise (Exceptions.Bad_footprint (try assert false with Assert_failure x -> x)) in @@ -196,7 +197,8 @@ let rec _strexp_extend_values let off_new = Sil.Off_index(Sil.exp_zero):: off in _strexp_extend_values pname tenv orig_prop footprint_part kind max_stamp se typ off_new inst - | (Sil.Off_fld (f, _)):: off', Sil.Estruct (fsel, inst'), Sil.Tstruct (ftal, sftal, csu, nameo, supers, def_mthds, iann) -> + | (Sil.Off_fld (f, _)):: off', Sil.Estruct (fsel, inst'), + Sil.Tstruct (ftal, sftal, csu, nameo, supers, def_mthds, iann) -> let replace_fv new_v fv = if Ident.fieldname_equal (fst fv) f then (f, new_v) else fv in let typ' = try (fun (x, y, z) -> y) (IList.find (fun (f', t', a') -> Ident.fieldname_equal f f') ftal) @@ -212,7 +214,9 @@ let rec _strexp_extend_values let res_fsel' = IList.sort Sil.fld_strexp_compare (IList.map replace_fse fsel) in let replace_fta (f, t, a) = let f', t' = replace_fv res_typ' (f, t) in (f', t', a) in let res_ftl' = IList.sort Sil.fld_typ_ann_compare (IList.map replace_fta ftal) in - (res_atoms', Sil.Estruct (res_fsel', inst'), Sil.Tstruct (res_ftl', sftal, csu, nameo, supers, def_mthds, iann)) :: acc in + let struct_typ = + Sil.Tstruct (res_ftl', sftal, csu, nameo, supers, def_mthds, iann) in + (res_atoms', Sil.Estruct (res_fsel', inst'), struct_typ) :: acc in IList.fold_left replace [] atoms_se_typ_list' with Not_found -> let atoms', se', res_typ' = @@ -221,7 +225,8 @@ let rec _strexp_extend_values let res_fsel' = IList.sort Sil.fld_strexp_compare ((f, se'):: fsel) in let replace_fta (f', t', a') = if Ident.fieldname_equal f' f then (f, res_typ', a') else (f', t', a') in let res_ftl' = IList.sort Sil.fld_typ_ann_compare (IList.map replace_fta ftal) in - [(atoms', Sil.Estruct (res_fsel', inst'), Sil.Tstruct (res_ftl', sftal, csu, nameo, supers, def_mthds, iann))] + let struct_typ = Sil.Tstruct (res_ftl', sftal, csu, nameo, supers, def_mthds, iann) in + [(atoms', Sil.Estruct (res_fsel', inst'), struct_typ)] end | (Sil.Off_fld (f, _)):: off', _, _ -> raise (Exceptions.Bad_footprint (try assert false with Assert_failure x -> x)) diff --git a/infer/src/backend/sil.ml b/infer/src/backend/sil.ml index 4d71f9fbe..5d7b8e1bc 100644 --- a/infer/src/backend/sil.ml +++ b/infer/src/backend/sil.ml @@ -88,18 +88,11 @@ let get_sentinel_func_attribute_value attr_list = | FA_sentinel (sentinel, null_pos) -> Some (sentinel, null_pos) with Not_found -> None -(** Class, struct, union, (Obj C) protocol *) -type csu = - | Class - | Struct - | Union - | Protocol - (** Named types. *) type typename = | TN_typedef of Mangled.t | TN_enum of Mangled.t - | TN_csu of csu * Mangled.t + | TN_csu of Csu.t * Mangled.t (** Kind of global variables *) type pvar_kind = @@ -145,7 +138,8 @@ type binop = | LAnd (** logical and. Does not always evaluate both operands. *) | LOr (** logical or. Does not always evaluate both operands. *) - | PtrFld (** field offset via pointer to field: takes the address of a csu and a Cptr_to_fld constant to form an Lfield expression (see prop.ml) *) + | PtrFld (** field offset via pointer to field: takes the address of a + Csu.t and a Cptr_to_fld constant to form an Lfield expression (see prop.ml) *) (** Kinds of integers *) type ikind = @@ -648,7 +642,8 @@ and const = | Cattribute of attribute (** attribute used in disequalities to annotate a value *) | Cexn of exp (** exception *) | Cclass of Ident.name (** class constant *) - | Cptr_to_fld of Ident.fieldname * typ (** pointer to field constant, and type of the surrounding csu type *) + | Cptr_to_fld of Ident.fieldname * typ (** pointer to field constant, + and type of the surrounding Csu.t type *) | Ctuple of exp list (** tuple of values *) and struct_fields = (Ident.fieldname * typ * item_annotation) list @@ -661,9 +656,10 @@ and typ = | Tvoid (** void type *) | Tfun of bool (** function type with noreturn attribute *) | Tptr of typ * ptr_kind (** pointer type *) - | Tstruct of struct_fields * struct_fields * csu * Mangled.t option * (csu * Mangled.t) list * Procname.t list * item_annotation (** structure type with class/struct/union flag and name and list of superclasses *) - (** Structure type with nonstatic and static fields, class/struct/union flag, name, list of superclasses, - methods defined, and annotations. + | Tstruct of struct_fields * struct_fields * Csu.t * Mangled.t option * + (Csu.t * Mangled.t) list * Procname.t list * item_annotation + (** Structure type with nonstatic and static fields, class/struct/union flag, name, + list of superclasses, methods defined, and annotations. The fld - typ pairs are always sorted. This means that we don't support programs that exploit specific layouts of C structs. *) | Tarray of typ * exp (** array type with fixed size *) @@ -1206,18 +1202,6 @@ let fkind_compare k1 k2 = match k1, k2 with | _, FDouble -> 1 | FLongDouble, FLongDouble -> 0 -let csu_compare csu1 csu2 = match csu1, csu2 with - | Class, Class -> 0 - | Class, _ -> -1 - | _, Class -> 1 - | Struct, Struct -> 0 - | Struct, _ -> -1 - | _, Struct -> 1 - | Union, Union -> 0 - | Union, _ -> -1 - | _, Union -> 1 - | Protocol, Protocol -> 0 - let typename_compare tn1 tn2 = match tn1, tn2 with | TN_typedef n1, TN_typedef n2 -> Mangled.compare n1 n2 | TN_typedef _, _ -> - 1 @@ -1226,17 +1210,9 @@ let typename_compare tn1 tn2 = match tn1, tn2 with | TN_enum _, _ -> -1 | _, TN_enum _ -> 1 | TN_csu (csu1, n1), TN_csu (csu2, n2) -> - let n = csu_compare csu1 csu2 in - if n <> 0 then n else Mangled.compare n1 n2 - -let csu_name_compare tn1 tn2 = match tn1, tn2 with - | (csu1, n1), (csu2, n2) -> - let n = csu_compare csu1 csu2 in + let n = Csu.compare csu1 csu2 in if n <> 0 then n else Mangled.compare n1 n2 -let csu_name_equal tn1 tn2 = - csu_name_compare tn1 tn2 = 0 - let typename_equal tn1 tn2 = typename_compare tn1 tn2 = 0 @@ -1321,10 +1297,11 @@ and typ_compare t1 t2 = if n <> 0 then n else ptr_kind_compare pk1 pk2 | Tptr _, _ -> - 1 | _, Tptr _ -> 1 - | Tstruct (ntal1, sntal1, csu1, nameo1, _, _, _), Tstruct (ntal2, sntal2, csu2, nameo2, _, _, _) -> + | Tstruct (ntal1, sntal1, csu1, nameo1, _, _, _), + Tstruct (ntal2, sntal2, csu2, nameo2, _, _, _) -> let n = fld_typ_ann_list_compare ntal1 ntal2 in if n <> 0 then n else let n = fld_typ_ann_list_compare sntal1 sntal2 in - if n <> 0 then n else let n = csu_compare csu1 csu2 in + if n <> 0 then n else let n = Csu.compare csu1 csu2 in if n <> 0 then n else cname_opt_compare nameo1 nameo2 | Tstruct _, _ -> - 1 | _, Tstruct _ -> 1 @@ -1817,16 +1794,10 @@ let fkind_to_string = function | FDouble -> "double" | FLongDouble -> "long double" -let csu_name = function - | Class -> "class" - | Struct -> "struct" - | Union -> "union" - | Protocol -> "protocol" - let typename_to_string = function | TN_enum name | TN_typedef name -> Mangled.to_string name - | TN_csu (csu, name) -> csu_name csu ^ " " ^ Mangled.to_string name + | TN_csu (csu, name) -> Csu.name csu ^ " " ^ Mangled.to_string name let typename_name = function | TN_enum name @@ -1994,15 +1965,16 @@ and pp_type_decl pe pp_base pp_size f = function | Tptr (typ, pk) -> let pp_base' fmt () = F.fprintf fmt "%s%a" (ptr_kind_string pk) pp_base () in pp_type_decl pe pp_base' pp_size f typ - | Tstruct (ftal, sftal, csu, Some name, _, _, _) when false -> (* remove "when false" to print the details of struct *) - F.fprintf f "%s %a {%a} %a" (csu_name csu) Mangled.pp name + | Tstruct (ftal, sftal, csu, Some name, _, _, _) when false -> + (* remove "when false" to print the details of struct *) + F.fprintf f "%s %a {%a} %a" (Csu.name csu) Mangled.pp name (pp_seq (fun f (fld, t, ann) -> F.fprintf f "%a %a" (pp_typ_full pe) t Ident.pp_fieldname fld)) ftal pp_base () | Tstruct (ftal, sftal, csu, Some name, _, _, _) -> - F.fprintf f "%s %a %a" (csu_name csu) Mangled.pp name pp_base () + F.fprintf f "%s %a %a" (Csu.name csu) Mangled.pp name pp_base () | Tstruct (ftal, sftal, csu, None, _, _, _) -> - F.fprintf f "%s {%a} %a" (csu_name csu) + F.fprintf f "%s {%a} %a" (Csu.name csu) (pp_seq (fun f (fld, t, ann) -> F.fprintf f "%a %a" (pp_typ_full pe) t Ident.pp_fieldname fld)) ftal pp_base () | Tarray (typ, size) -> let pp_base' fmt () = F.fprintf fmt "%a[%a]" pp_base () (pp_size pe) size in @@ -3808,7 +3780,7 @@ let tenv_add tenv name typ = let get_typ name csu_option tenv = let csu = match csu_option with | Some t -> t - | None -> Class in + | None -> Csu.Class in tenv_lookup tenv (TN_csu (csu, name)) (** expand a type if it is a typename by looking it up in the type environment *) diff --git a/infer/src/backend/sil.mli b/infer/src/backend/sil.mli index 9e1dec6e6..c86869eb0 100644 --- a/infer/src/backend/sil.mli +++ b/infer/src/backend/sil.mli @@ -12,18 +12,11 @@ open Utils -(** Class, struct, union, (Obj C) protocol *) -type csu = - | Class - | Struct - | Union - | Protocol - (** Named types. *) type typename = | TN_typedef of Mangled.t | TN_enum of Mangled.t - | TN_csu of csu * Mangled.t + | TN_csu of Csu.t * Mangled.t (** {2 Programs and Types} *) @@ -84,7 +77,8 @@ type binop = | LAnd (** logical and. Does not always evaluate both operands. *) | LOr (** logical or. Does not always evaluate both operands. *) - | PtrFld (** field offset via pointer to field: takes the address of a csu and a Cptr_to_fld constant to form an Lfield expression (see prop.ml) *) + | PtrFld (** field offset via pointer to field: takes the address of a + Csu.t and a Cptr_to_fld constant to form an Lfield expression (see prop.ml) *) (** Kinds of integers *) type ikind = @@ -283,7 +277,8 @@ and const = | Cattribute of attribute (** attribute used in disequalities to annotate a value *) | Cexn of exp (** exception *) | Cclass of Ident.name (** class constant *) - | Cptr_to_fld of Ident.fieldname * typ (** pointer to field constant, and type of the surrounding csu type *) + | Cptr_to_fld of Ident.fieldname * typ (** pointer to field constant, + and type of the surrounding Csu.t type *) | Ctuple of exp list (** tuple of values *) and struct_fields = (Ident.fieldname * typ * item_annotation) list @@ -296,7 +291,8 @@ and typ = | Tvoid (** void type *) | Tfun of bool (** function type with noreturn attribute *) | Tptr of typ * ptr_kind (** pointer type *) - | Tstruct of struct_fields * struct_fields * csu * Mangled.t option * (csu * Mangled.t) list * Procname.t list * item_annotation + | Tstruct of struct_fields * struct_fields * Csu.t * Mangled.t option * + (Csu.t * Mangled.t) list * Procname.t list * item_annotation (** Structure type with nonstatic and static fields, class/struct/union flag, name, list of superclasses, methods defined, and annotations. The fld - typ pairs are always sorted. This means that we don't support programs that exploit specific layouts @@ -524,7 +520,7 @@ val tenv_lookup : tenv -> typename -> typ option val tenv_add : tenv -> typename -> typ -> unit (** look up the type for a mangled name in the current type environment *) -val get_typ : Mangled.t -> csu option -> tenv -> typ option +val get_typ : Mangled.t -> Csu.t option -> tenv -> typ option (** expand a type if it is a typename by looking it up in the type environment *) val expand_type : tenv -> typ -> typ @@ -646,9 +642,6 @@ val typename_compare : typename -> typename -> int (** Equality for typenames *) val typename_equal : typename -> typename -> bool -(** Equality for typenames *) -val csu_name_equal : (csu * Mangled.t) -> (csu * Mangled.t) -> bool - (** Comparision for ptr_kind *) val ptr_kind_compare : ptr_kind -> ptr_kind -> int diff --git a/infer/src/backend/symExec.ml b/infer/src/backend/symExec.ml index d2f419682..8a00eba25 100644 --- a/infer/src/backend/symExec.ml +++ b/infer/src/backend/symExec.ml @@ -156,7 +156,11 @@ let rec apply_offlist | (Sil.Off_fld (fld, fld_typ)):: offlist', Sil.Estruct (fsel, inst') -> begin let typ' = Sil.expand_type tenv typ in - let ftal, sftal, csu, nameo, supers, def_mthds, iann = match typ' with Sil.Tstruct (ftal, sftal, csu, nameo, supers, def_mthds, iann) -> ftal, sftal, csu, nameo, supers, def_mthds, iann | _ -> assert false in + let ftal, sftal, csu, nameo, supers, def_mthds, iann = + match typ' with + | Sil.Tstruct (ftal, sftal, csu, nameo, supers, def_mthds, iann) -> + ftal, sftal, csu, nameo, supers, def_mthds, iann + | _ -> assert false in let t' = unroll_type tenv typ (Sil.Off_fld (fld, fld_typ)) in try let _, se' = IList.find (fun fse -> Ident.fieldname_equal fld (fst fse)) fsel in @@ -167,7 +171,9 @@ let rec apply_offlist let replace_fse fse = if Sil.fld_equal fld (fst fse) then (fld, res_se') else fse in let res_se = Sil.Estruct (IList.map replace_fse fsel, inst') in let replace_fta (f, t, a) = if Sil.fld_equal fld f then (fld, res_t', a) else (f, t, a) in - let res_t = Sil.Tstruct (IList.map replace_fta ftal, sftal, csu, nameo, supers, def_mthds, iann) in + let res_t = + Sil.Tstruct + (IList.map replace_fta ftal, sftal, csu, nameo, supers, def_mthds, iann) in (res_e', res_se, res_t, res_pred_insts_op') with Not_found -> pp_error(); @@ -599,14 +605,14 @@ let resolve_method tenv class_name proc_name = if Procname.is_java proc_name then Procname.java_replace_class proc_name (Mangled.to_string class_name) else Procname.c_method_replace_class proc_name (Mangled.to_string class_name) in - let type_name = Sil.TN_csu (Sil.Class, class_name) in + let type_name = Sil.TN_csu (Csu.Class, class_name) in match Sil.tenv_lookup tenv type_name with - | Some (Sil.Tstruct (_, _, Sil.Class, cls, super_classes, methods, iann)) -> + | Some (Sil.Tstruct (_, _, Csu.Class, cls, super_classes, methods, iann)) -> if method_exists right_proc_name methods then Some right_proc_name else (match super_classes with - | (Sil.Class, super_class):: interfaces -> + | (Csu.Class, super_class):: interfaces -> if not (Mangled.MangledSet.mem super_class !visited) then resolve super_class else None @@ -629,7 +635,8 @@ let resolve_typename prop arg = | _ :: hpreds -> loop hpreds in loop (Prop.get_sigma prop) in match typexp_opt with - | Some (Sil.Sizeof (Sil.Tstruct (_, _, Sil.Class, class_name_opt, _, _, _), _)) -> class_name_opt + | Some (Sil.Sizeof (Sil.Tstruct (_, _, Csu.Class, class_name_opt, _, _, _), _)) -> + class_name_opt | _ -> None (** If the dynamic type of the object calling a method is known, the method from the dynamic type @@ -650,7 +657,7 @@ let resolve_virtual_pname cfg tenv prop args pname : Procname.t = let redirect_shared_ptr tenv cfg pname actual_params = let class_shared_ptr typ = try match Sil.expand_type tenv typ with - | Sil.Tstruct (_, _, Sil.Class, Some cl_name, _, _, _) -> + | Sil.Tstruct (_, _, Csu.Class, Some cl_name, _, _, _) -> let name = Mangled.to_string cl_name in name = "shared_ptr" || name = "__shared_ptr" | t -> false @@ -980,7 +987,8 @@ let rec sym_exec cfg tenv pdesc _instr (_prop: Prop.normal Prop.t) path (* iOS: check that NSNumber *'s are not used in conditionals without comparing to nil *) let lhs_normal = Prop.exp_normalize_prop _prop lhs in let is_nsnumber = function - | Sil.Tvar (Sil.TN_csu (Sil.Class, name)) -> Mangled.to_string name = "NSNumber" + | Sil.Tvar (Sil.TN_csu (Csu.Class, name)) -> + Mangled.to_string name = "NSNumber" | _ -> false in let lhs_is_ns_ptr () = IList.exists @@ -2448,7 +2456,7 @@ module ModelBuiltins = struct sym_exec_generated false cfg tenv pdesc [alloc_instr] symb_state let execute_objc_NSArray_alloc_no_fail cfg pdesc tenv symb_state ret_ids loc = - let nsarray_typ = Sil.Tvar (Sil.TN_csu (Sil.Class, Mangled.from_string "NSArray")) in + let nsarray_typ = Sil.Tvar (Sil.TN_csu (Csu.Class, Mangled.from_string "NSArray")) in let nsarray_typ = Sil.expand_type tenv nsarray_typ in execute_objc_alloc_no_fail cfg pdesc tenv symb_state ret_ids nsarray_typ loc @@ -2474,8 +2482,10 @@ module ModelBuiltins = struct execute_NSArray_arrayWithObjects let execute_objc_NSDictionary_alloc_no_fail cfg pdesc tenv symb_state ret_ids loc = - let nsdictionary_typ = Sil.Tvar (Sil.TN_csu (Sil.Class, Mangled.from_string "NSDictionary")) in - let nsdictionary_typ = Sil.expand_type tenv nsdictionary_typ in + let nsdictionary_typ = + Sil.Tvar (Sil.TN_csu (Csu.Class, Mangled.from_string "NSDictionary")) in + let nsdictionary_typ = + Sil.expand_type tenv nsdictionary_typ in execute_objc_alloc_no_fail cfg pdesc tenv symb_state ret_ids nsdictionary_typ loc let execute___objc_dictionary_literal cfg pdesc instr tenv prop path ret_ids args callee_pname loc = diff --git a/infer/src/backend/tabulation.ml b/infer/src/backend/tabulation.ml index af7eeb52a..31bc00ee6 100644 --- a/infer/src/backend/tabulation.ml +++ b/infer/src/backend/tabulation.ml @@ -443,7 +443,8 @@ let texp_star texp1 texp2 = | 0 -> ftal_sub ftal1' ftal2' | _ -> ftal_sub ftal1 ftal2' end in let typ_star t1 t2 = match t1, t2 with - | Sil.Tstruct (ftal1, sftal1, csu1, _, _, _, _), Sil.Tstruct (ftal2, sftal2, csu2, _, _, _, _) when csu1 = csu2 -> + | Sil.Tstruct (ftal1, sftal1, csu1, _, _, _, _), + Sil.Tstruct (ftal2, sftal2, csu2, _, _, _, _) when csu1 = csu2 -> if ftal_sub ftal1 ftal2 then t2 else t1 | _ -> t1 in match texp1, texp2 with diff --git a/infer/src/backend/type_prop.ml b/infer/src/backend/type_prop.ml index cc8b40467..e5390db1d 100644 --- a/infer/src/backend/type_prop.ml +++ b/infer/src/backend/type_prop.ml @@ -99,8 +99,8 @@ struct let rec type_to_string typ = match typ with | Sil.Tptr (typ , _) -> type_to_string typ - | Sil.Tstruct (_, _, Sil.Class, Some mangled, _, _, _) - | Sil.Tvar ( Sil.TN_csu (Sil.Class, (mangled))) -> Mangled.to_string mangled + | Sil.Tstruct (_, _, Csu.Class, Some mangled, _, _, _) + | Sil.Tvar ( Sil.TN_csu (Csu.Class, (mangled))) -> Mangled.to_string mangled | _ -> Sil.typ_to_string typ let string_typ_to_string (s, typ) = @@ -311,8 +311,8 @@ let initial_node = ref (Cfg.Node.dummy ()) let rec super tenv t = match t with - | Sil.Tstruct (_, _, Sil.Class, Some c2, (Sil.Class, super):: rest, _, _) -> - Sil.tenv_lookup tenv (Sil.TN_csu (Sil.Class, super)) + | Sil.Tstruct (_, _, Csu.Class, Some c2, (Csu.Class, super):: rest, _, _) -> + Sil.tenv_lookup tenv (Sil.TN_csu (Csu.Class, super)) | Sil.Tarray (dom_type, _) -> None | Sil.Tptr (dom_type, p) -> let super_dom_type = super tenv dom_type in @@ -412,7 +412,7 @@ struct | Sil.Cfun fn -> assert false | Sil.Cstr str -> Sil.Tptr ( - Sil.Tvar ( Sil.TN_csu (Sil.Class, (Mangled.from_string ( "java.lang.String")))), + Sil.Tvar ( Sil.TN_csu (Csu.Class, (Mangled.from_string ( "java.lang.String")))), Sil.Pk_pointer) | Sil.Cattribute atr -> assert false | Sil.Cexn e -> assert false diff --git a/infer/src/checkers/callbackChecker.ml b/infer/src/checkers/callbackChecker.ml index 96c5df8a6..7b8215a8d 100644 --- a/infer/src/checkers/callbackChecker.ml +++ b/infer/src/checkers/callbackChecker.ml @@ -94,7 +94,7 @@ let callback_checker_main all_procs get_procdesc idenv tenv proc_name proc_desc let registered_callback_procs' = IList.fold_left (fun callback_procs callback_typ -> match callback_typ with - | Sil.Tptr (Sil.Tstruct(_, _, Sil.Class, Some class_name, _, methods, _), _) -> + | Sil.Tptr (Sil.Tstruct(_, _, Csu.Class, Some class_name, _, methods, _), _) -> IList.fold_left (fun callback_procs callback_proc -> if Procname.is_constructor callback_proc then callback_procs diff --git a/infer/src/checkers/eradicateChecks.ml b/infer/src/checkers/eradicateChecks.ml index 58221c69e..5b8c08061 100644 --- a/infer/src/checkers/eradicateChecks.ml +++ b/infer/src/checkers/eradicateChecks.ml @@ -130,7 +130,7 @@ let check_condition case_zero find_canonical_duplicate get_proc_desc curr_pname let throwable_found = ref false in let throwable_class = Mangled.from_string "java.lang.Throwable" in let typ_is_throwable = function - | Sil.Tstruct (_, _, Sil.Class, Some c, _, _, _) -> + | Sil.Tstruct (_, _, Csu.Class, Some c, _, _, _) -> Mangled.equal c throwable_class | _ -> false in let do_instr = function diff --git a/infer/src/checkers/patternMatch.ml b/infer/src/checkers/patternMatch.ml index 53e9cf289..bc3ccb7b6 100644 --- a/infer/src/checkers/patternMatch.ml +++ b/infer/src/checkers/patternMatch.ml @@ -45,7 +45,7 @@ let type_get_direct_supertypes = function let type_get_class_name t = match t with | Sil.Tptr (Sil.Tstruct (_, _, _, Some cn, _, _, _), _) -> Some cn - | Sil.Tptr (Sil.Tvar (Sil.TN_csu (Sil.Class, cn)), _) -> + | Sil.Tptr (Sil.Tvar (Sil.TN_csu (Csu.Class, cn)), _) -> Some cn | _ -> None @@ -65,7 +65,7 @@ let type_has_direct_supertype (t : Sil.typ) (s : Mangled.t) = let type_find_supertype (tenv: Sil.tenv) (typ: Sil.typ) - (csu_option: Sil.csu option) + (csu_opt: Csu.t option) (filter: Mangled.t -> bool): bool = let rec has_supertype typ visited = if Sil.TypSet.mem typ visited then @@ -77,14 +77,15 @@ let type_find_supertype | Sil.Tstruct (_, _, _, _, supertypes, _, _) -> let match_supertype (csu, m) = let match_name () = filter m in - let match_csu () = match csu_option with + let match_csu () = match csu_opt with | Some c -> c = csu | None -> true in let has_indirect_supertype () = - match Sil.get_typ m csu_option tenv with + match Sil.get_typ m csu_opt tenv with | Some supertype -> has_supertype supertype (Sil.TypSet.add typ visited) | None -> false in - (match_csu () && match_name () (* only and always visit name with expected csu *)) + (match_csu () && match_name () + (* only and always visit name with expected csu *)) || has_indirect_supertype () in IList.exists match_supertype supertypes | _ -> false @@ -94,20 +95,20 @@ let type_find_supertype let type_has_supertype (tenv: Sil.tenv) (typ: Sil.typ) - (csu_option: Sil.csu option) + (csu_opt: Csu.t option) (name: Mangled.t): bool = let filter m = Mangled.equal m name in - type_find_supertype tenv typ csu_option filter + type_find_supertype tenv typ csu_opt filter let type_get_supertypes (tenv: Sil.tenv) (typ: Sil.typ) - (csu_option: Sil.csu option) : Mangled.t list = + (csu_opt: Csu.t option) : Mangled.t list = let res = ref [] in let filter m = res := m :: !res; false in - let _ = type_find_supertype tenv typ csu_option filter in + let _ = type_find_supertype tenv typ csu_opt filter in IList.rev !res let type_is_nested_in_type t n = match t with @@ -269,7 +270,7 @@ let initializer_methods = [ let type_has_initializer (tenv: Sil.tenv) (t: Sil.typ): bool = - let check_candidate cname = type_has_supertype tenv t (Some Sil.Class) cname in + let check_candidate cname = type_has_supertype tenv t (Some Csu.Class) cname in IList.exists check_candidate initializer_classes (** Check if the method is one of the known initializer methods. *) @@ -328,7 +329,7 @@ let proc_iter_overridden_methods f tenv proc_name = let do_super_type tenv super_class_name = let super_proc_name = Procname.java_replace_class proc_name (Mangled.to_string super_class_name) in - let type_name = Sil.TN_csu (Sil.Class, super_class_name) in + let type_name = Sil.TN_csu (Csu.Class, super_class_name) in match Sil.tenv_lookup tenv type_name with | Some (Sil.Tstruct (_, _, _, _, _, methods, _)) -> let is_override pname = @@ -344,7 +345,7 @@ let proc_iter_overridden_methods f tenv proc_name = if Procname.is_java proc_name then let type_name = let class_name = Procname.java_get_class proc_name in - Sil.TN_csu (Sil.Class, Mangled.from_string class_name) in + Sil.TN_csu (Csu.Class, 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) diff --git a/infer/src/checkers/patternMatch.mli b/infer/src/checkers/patternMatch.mli index 9be3ae895..645b6b4ba 100644 --- a/infer/src/checkers/patternMatch.mli +++ b/infer/src/checkers/patternMatch.mli @@ -66,21 +66,21 @@ val type_get_class_name : Sil.typ -> Mangled.t option val type_get_direct_supertypes : Sil.typ -> Mangled.t list -val type_get_supertypes : Sil.tenv -> Sil.typ -> Sil.csu option -> Mangled.t list +val type_get_supertypes : Sil.tenv -> Sil.typ -> Csu.t option -> Mangled.t list (** Is the type a class with the given name *) val type_has_class_name : Sil.typ -> Mangled.t -> bool val type_has_direct_supertype : Sil.typ -> Mangled.t -> bool -val type_has_supertype : Sil.tenv -> Sil.typ -> Sil.csu option -> Mangled.t -> bool +val type_has_supertype : Sil.tenv -> Sil.typ -> Csu.t option -> Mangled.t -> bool (** Is the type a class type *) val type_is_class : Sil.typ -> bool val type_is_nested_in_direct_supertype : Sil.typ -> Mangled.t -> bool -val type_is_nested_in_supertype : Sil.tenv -> Sil.typ -> Sil.csu option -> Mangled.t -> bool +val type_is_nested_in_supertype : Sil.tenv -> Sil.typ -> Csu.t option -> Mangled.t -> bool val type_is_nested_in_type : Sil.typ -> Mangled.t -> bool diff --git a/infer/src/checkers/performanceCritical.ml b/infer/src/checkers/performanceCritical.ml index 3a629cb4f..a206068f5 100644 --- a/infer/src/checkers/performanceCritical.ml +++ b/infer/src/checkers/performanceCritical.ml @@ -79,7 +79,7 @@ let is_modeled_expensive tenv pname = | Some p -> p in let classname = Mangled.from_package_class package (Procname.java_get_simple_class pname) in - match Sil.get_typ classname (Some Sil.Class) tenv with + match Sil.get_typ classname (Some Csu.Class) tenv with | None -> false | Some typ -> AndroidFramework.is_view typ tenv diff --git a/infer/src/clang/cContext.ml b/infer/src/clang/cContext.ml index a13dff164..a9ae2686c 100644 --- a/infer/src/clang/cContext.ml +++ b/infer/src/clang/cContext.ml @@ -116,7 +116,7 @@ let curr_class_hash curr_class = | ContextNoCls -> Hashtbl.hash "no class" let create_curr_class tenv class_name = - let class_tn_name = Sil.TN_csu (Sil.Class, (Mangled.from_string class_name)) in + let class_tn_name = Sil.TN_csu (Csu.Class, (Mangled.from_string class_name)) in match Sil.tenv_lookup tenv class_tn_name with | Some Sil.Tstruct(intf_fields, _, _, _, superclasses, methods, annotation) -> (let superclasses_names = IList.map (fun (_, name) -> Mangled.to_string name) superclasses in diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index 2b7f85ed4..99a9b190a 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -20,8 +20,8 @@ let rec get_fields_super_classes tenv super_class = Printing.log_out " ... Getting fields of superclass '%s'\n" (Sil.typename_to_string super_class); match Sil.tenv_lookup tenv super_class with | None -> [] - | Some Sil.Tstruct (fields, _, _, _, (Sil.Class, sc):: _, _, _) -> - let sc_fields = get_fields_super_classes tenv (Sil.TN_csu (Sil.Class, sc)) in + | Some Sil.Tstruct (fields, _, _, _, (Csu.Class, sc):: _, _, _) -> + let sc_fields = get_fields_super_classes tenv (Sil.TN_csu (Csu.Class, sc)) in General_utils.append_no_duplicates_fields fields sc_fields | Some Sil.Tstruct (fields, _, _, _, _, _, _) -> fields | Some _ -> [] @@ -77,14 +77,14 @@ let rec get_fields type_ptr_to_sil_type tenv curr_class decl_list = (* to the info given in the interface. Update the tenv accordingly. *) let add_missing_fields tenv class_name fields = let mang_name = Mangled.from_string class_name in - let class_tn_name = Sil.TN_csu (Sil.Class, mang_name) in + let class_tn_name = Sil.TN_csu (Csu.Class, mang_name) in match Sil.tenv_lookup tenv class_tn_name with | Some Sil.Tstruct(intf_fields, _, _, _, superclass, methods, annotation) -> let new_fields = General_utils.append_no_duplicates_fields fields intf_fields in let new_fields = CFrontend_utils.General_utils.sort_fields new_fields in let class_type_info = Sil.Tstruct ( - new_fields, [], Sil.Class, Some mang_name, superclass, methods, annotation + new_fields, [], Csu.Class, Some mang_name, superclass, methods, annotation ) 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_checkers.ml b/infer/src/clang/cFrontend_checkers.ml index 90f9ea04d..82849e373 100644 --- a/infer/src/clang/cFrontend_checkers.ml +++ b/infer/src/clang/cFrontend_checkers.ml @@ -40,7 +40,7 @@ let direct_atomic_property_access context stmt_info ivar_name = General_utils.mk_class_field_name n, Ast_utils.get_class_name_from_member n | _ -> Ident.create_fieldname (Mangled.from_string "") 0, "" in - let tname = Sil.TN_csu (Sil.Class, Mangled.from_string cname) in + let tname = Sil.TN_csu (Csu.Class, Mangled.from_string cname) in let loc = CLocation.get_sil_location_from_range stmt_info.Clang_ast_t.si_source_range true in match Sil.tenv_lookup tenv tname with | Some Sil.Tstruct (flds1, flds2, _, _, _, _, _) -> diff --git a/infer/src/clang/cFrontend_utils.ml b/infer/src/clang/cFrontend_utils.ml index a6ece500b..e6c46aedf 100644 --- a/infer/src/clang/cFrontend_utils.ml +++ b/infer/src/clang/cFrontend_utils.ml @@ -43,7 +43,7 @@ struct let print_tenv tenv = Sil.tenv_iter (fun typname typ -> match typname with - | Sil.TN_csu (Sil.Class, _) | Sil.TN_csu (Sil.Protocol, _) -> + | Sil.TN_csu (Csu.Class, _) | Sil.TN_csu (Csu.Protocol, _) -> (match typ with | Sil.Tstruct (fields, _, _, cls, super_classes, methods, iann) -> print_endline ( @@ -62,7 +62,7 @@ struct let print_tenv_struct_unions tenv = Sil.tenv_iter (fun typname typ -> match typname with - | Sil.TN_csu (Sil.Struct, _) | Sil.TN_csu (Sil.Union, _) -> + | Sil.TN_csu (Csu.Struct, _) | Sil.TN_csu (Csu.Union, _) -> (match typ with | (Sil.Tstruct (fields, static_fields, _, cls, super_classes, methods, iann)) -> (print_endline ( @@ -430,7 +430,10 @@ struct | [] -> list1 let append_no_duplicates_csu list1 list2 = - append_no_duplicates Sil.csu_name_equal list1 list2 + append_no_duplicates + (fun (ds1, n1) (ds2, n2) -> + Csu.equal ds1 ds2 && Mangled.equal n1 n2) + list1 list2 let append_no_duplicates_methods list1 list2 = append_no_duplicates Procname.equal list1 list2 diff --git a/infer/src/clang/cFrontend_utils.mli b/infer/src/clang/cFrontend_utils.mli index e78e2a975..6e4e0a9f2 100644 --- a/infer/src/clang/cFrontend_utils.mli +++ b/infer/src/clang/cFrontend_utils.mli @@ -138,7 +138,8 @@ sig val append_no_duplicates_fields : (Ident.fieldname * Sil.typ * Sil.item_annotation) list -> (Ident.fieldname * Sil.typ * Sil.item_annotation) list -> (Ident.fieldname * Sil.typ * Sil.item_annotation) list - val append_no_duplicates_csu : (Sil.csu * Mangled.t) list -> (Sil.csu * Mangled.t) list -> (Sil.csu * Mangled.t) list + val append_no_duplicates_csu : + (Csu.t * Mangled.t) list -> (Csu.t * Mangled.t) list -> (Csu.t * Mangled.t) list val append_no_duplicates_methods : Procname.t list -> Procname.t list -> Procname.t list diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index c91fb7344..40b65872d 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -188,7 +188,7 @@ let get_method_name_from_clang tenv ms_opt = let get_superclass_curr_class context = let retrive_super cname super_opt = - let iname = Sil.TN_csu (Sil.Class, Mangled.from_string cname) in + let iname = Sil.TN_csu (Csu.Class, Mangled.from_string cname) in Printing.log_out "Checking for superclass = '%s'\n\n%!" (Sil.typename_to_string iname); match Sil.tenv_lookup (CContext.get_tenv context) iname with | Some Sil.Tstruct(_, _, _, _, (_, super_name):: _, _, _) -> diff --git a/infer/src/clang/cTrans.ml b/infer/src/clang/cTrans.ml index 7a99ed9fc..9f5c95697 100644 --- a/infer/src/clang/cTrans.ml +++ b/infer/src/clang/cTrans.ml @@ -118,8 +118,8 @@ struct IList.iter (fun (fn, ft, _) -> 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 (fields, [], Sil.Class, Some mblock, [], [], []) in - let block_name = Sil.TN_csu (Sil.Class, mblock) in + let block_type = Sil.Tstruct (fields, [], Csu.Class, Some mblock, [], [], []) in + let block_name = Sil.TN_csu (Csu.Class, mblock) in Sil.tenv_add tenv block_name block_type; 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 diff --git a/infer/src/clang/cType_to_sil_type.ml b/infer/src/clang/cType_to_sil_type.ml index dbebbceb6..1edd6c29f 100644 --- a/infer/src/clang/cType_to_sil_type.ml +++ b/infer/src/clang/cType_to_sil_type.ml @@ -11,8 +11,8 @@ open CFrontend_utils let get_builtin_objc_typename builtin_type = match builtin_type with - | `ObjCId -> Sil.TN_csu (Sil.Struct, (Mangled.from_string CFrontend_config.objc_object)) - | `ObjCClass -> Sil.TN_csu (Sil.Struct, (Mangled.from_string CFrontend_config.objc_class)) + | `ObjCId -> Sil.TN_csu (Csu.Struct, (Mangled.from_string CFrontend_config.objc_object)) + | `ObjCClass -> Sil.TN_csu (Csu.Struct, (Mangled.from_string CFrontend_config.objc_class)) let get_builtin_objc_type builtin_type = let typ = Sil.Tvar (get_builtin_objc_typename builtin_type) in diff --git a/infer/src/clang/cTypes.ml b/infer/src/clang/cTypes.ml index 9ed23a22e..c90f6c93f 100644 --- a/infer/src/clang/cTypes.ml +++ b/infer/src/clang/cTypes.ml @@ -65,9 +65,9 @@ let search_enum_type_by_name tenv name = Sil.tenv_iter f tenv; !found -let mk_classname n = Sil.TN_csu (Sil.Class, Mangled.from_string n) +let mk_classname n = Sil.TN_csu (Csu.Class, Mangled.from_string n) -let mk_structname n = Sil.TN_csu (Sil.Struct, Mangled.from_string n) +let mk_structname n = Sil.TN_csu (Csu.Struct, Mangled.from_string n) let mk_enumname n = Sil.TN_enum (Mangled.from_string n) diff --git a/infer/src/clang/cTypes_decl.ml b/infer/src/clang/cTypes_decl.ml index a23c463e9..ea58600db 100644 --- a/infer/src/clang/cTypes_decl.ml +++ b/infer/src/clang/cTypes_decl.ml @@ -17,21 +17,21 @@ exception Typename_not_found let add_predefined_objc_types tenv = let objc_class_mangled = Mangled.from_string CFrontend_config.objc_class in - let objc_class_name = Sil.TN_csu (Sil.Class, objc_class_mangled) in + let objc_class_name = Sil.TN_csu (Csu.Class, objc_class_mangled) in let objc_class_type_info = - Sil.Tstruct ([], [], Sil.Struct, + Sil.Tstruct ([], [], Csu.Struct, Some (Mangled.from_string CFrontend_config.objc_class), [], [], []) in Sil.tenv_add tenv objc_class_name objc_class_type_info; let class_typename = CType_to_sil_type.get_builtin_objc_typename `ObjCClass in - let class_typ = Sil.Tvar (Sil.TN_csu (Sil.Struct, objc_class_mangled)) in + let class_typ = Sil.Tvar (Sil.TN_csu (Csu.Struct, objc_class_mangled)) in Sil.tenv_add tenv class_typename class_typ; let typename_objc_object = - Sil.TN_csu (Sil.Struct, Mangled.from_string CFrontend_config.objc_object) in + Sil.TN_csu (Csu.Struct, Mangled.from_string CFrontend_config.objc_object) in let id_typedef = Sil.Tvar (typename_objc_object) in let id_typename = CType_to_sil_type.get_builtin_objc_typename `ObjCId in Sil.tenv_add tenv id_typename id_typedef; let objc_object_type_info = - Sil.Tstruct ([], [], Sil.Struct, + Sil.Tstruct ([], [], Csu.Struct, Some (Mangled.from_string CFrontend_config.objc_object), [], [], []) in Sil.tenv_add tenv typename_objc_object objc_object_type_info @@ -75,10 +75,10 @@ let create_csu opt_type = | `Type s -> (let buf = Str.split (Str.regexp "[ \t]+") s in match buf with - | "struct":: l ->Sil.Struct - | "class":: l -> Sil.Class - | "union":: l -> Sil.Union - | _ -> Sil.Struct) + | "struct":: l ->Csu.Struct + | "class":: l -> Csu.Class + | "union":: l -> Csu.Union + | _ -> Csu.Struct) | _ -> assert false (* We need to take the name out of the type as the struct can be anonymous*) @@ -88,12 +88,12 @@ let get_record_name_csu decl = | RecordDecl (_, name_info, opt_type, _, _, _, _) -> name_info, opt_type, false | CXXRecordDecl (_, name_info, opt_type, _, _, _, _, cxx_record_info) | ClassTemplateSpecializationDecl (_, name_info, opt_type, _, _, _, _, cxx_record_info) -> - (* we use Sil.Class for C++ because we expect Sil.Class csu from *) + (* we use Csu.Class for C++ because we expect Csu.Class csu from *) (* types that have methods. And in C++ struct/class/union can have methods *) name_info, opt_type, not cxx_record_info.xrdi_is_c_like | _-> assert false in let csu = create_csu opt_type in - let csu' = if should_be_class then Sil.Class else csu in + let csu' = if should_be_class then Csu.Class else csu in let name = Ast_utils.get_qualified_name name_info in csu', name @@ -143,7 +143,7 @@ let get_superclass_decls decl = let get_superclass_list decl = let base_decls = get_superclass_decls decl in let decl_to_mangled_name decl = Mangled.from_string (get_record_name decl) in - let get_super_field super_decl = (Sil.Class, decl_to_mangled_name super_decl) in + let get_super_field super_decl = (Csu.Class, decl_to_mangled_name super_decl) in IList.map get_super_field base_decls let add_struct_to_tenv tenv typ = @@ -202,8 +202,8 @@ and get_struct_cpp_class_declaration_type tenv decl = let methods = get_class_methods tenv name decl_list in (* C++ methods only *) let superclasses = get_superclass_list decl in let item_annotation = Sil.item_annotation_empty in (* No annotations for struts *) - let sil_type = Sil.Tstruct (sorted_non_static_fields, static_fields, csu, Some mangled_name, - superclasses, methods, item_annotation) in + let sil_type = Sil.Tstruct (sorted_non_static_fields, static_fields, csu, + Some mangled_name, superclasses, methods, item_annotation) in Ast_utils.update_sil_types_map type_ptr sil_type; add_struct_to_tenv tenv sil_type; sil_type @@ -249,5 +249,5 @@ let get_class_type_np tenv expr_info obj_c_message_expr_info = let get_type_curr_class tenv curr_class_opt = let name = CContext.get_curr_class_name curr_class_opt in - let typ = Sil.Tvar (Sil.TN_csu (Sil.Class, (Mangled.from_string name))) in + let typ = Sil.Tvar (Sil.TN_csu (Csu.Class, (Mangled.from_string name))) in CTypes.expand_structured_type tenv typ diff --git a/infer/src/clang/objcCategory_decl.ml b/infer/src/clang/objcCategory_decl.ml index cb6d5cadf..74eded657 100644 --- a/infer/src/clang/objcCategory_decl.ml +++ b/infer/src/clang/objcCategory_decl.ml @@ -73,7 +73,7 @@ let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list = let methods = ObjcProperty_decl.get_methods curr_class decl_list in let class_name = CContext.get_curr_class_name curr_class in let mang_name = Mangled.from_string class_name in - let class_tn_name = Sil.TN_csu (Sil.Class, mang_name) in + let class_tn_name = Sil.TN_csu (Csu.Class, mang_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 @@ -83,7 +83,7 @@ let process_category type_ptr_to_sil_type tenv curr_class decl_info decl_list = let new_methods = General_utils.append_no_duplicates_methods methods intf_methods in let class_type_info = Sil.Tstruct ( - new_fields, [], Sil.Class, Some mang_name, superclass, new_methods, annotation + new_fields, [], Csu.Class, Some mang_name, superclass, new_methods, annotation ) 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 205c79292..59891ed81 100644 --- a/infer/src/clang/objcInterface_decl.ml +++ b/infer/src/clang/objcInterface_decl.ml @@ -31,11 +31,11 @@ let is_objc_class_annotation a = let is_pointer_to_objc_class tenv typ = match typ with - | Sil.Tptr (Sil.Tvar (Sil.TN_csu (Sil.Class, cname)), _) -> - (match Sil.tenv_lookup tenv (Sil.TN_csu (Sil.Class, cname)) with - | Some Sil.Tstruct(_, _, Sil.Class, _, _, _, a) when is_objc_class_annotation a -> true + | Sil.Tptr (Sil.Tvar (Sil.TN_csu (Csu.Class, cname)), _) -> + (match Sil.tenv_lookup tenv (Sil.TN_csu (Csu.Class, cname)) with + | Some Sil.Tstruct(_, _, Csu.Class, _, _, _, a) when is_objc_class_annotation a -> true | _ -> false) - | Sil.Tptr (Sil.Tstruct(_, _, Sil.Class, _, _, _, a), _) when + | Sil.Tptr (Sil.Tstruct(_, _, Csu.Class, _, _, _, a), _) when is_objc_class_annotation a -> true | _ -> false @@ -92,9 +92,9 @@ let get_interface_superclasses super_opt protocols = let super_class = match super_opt with | None -> [] - | Some super -> [(Sil.Class, Mangled.from_string super)] in + | Some super -> [(Csu.Class, Mangled.from_string super)] in let protocol_names = IList.map ( - fun name -> (Sil.Protocol, Mangled.from_string name) + fun name -> (Csu.Protocol, Mangled.from_string name) ) protocols in let super_classes = super_class@protocol_names in super_classes @@ -138,7 +138,7 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name IList.iter (fun (fn, ft, _) -> Printing.log_out "-----> field: '%s'\n" (Ident.fieldname_to_string fn)) fields; let interface_type_info = - Sil.Tstruct(fields, [], Sil.Class, Some (Mangled.from_string class_name), + Sil.Tstruct(fields, [], Csu.Class, Some (Mangled.from_string class_name), superclasses, methods, objc_class_annotation) in Sil.tenv_add tenv interface_name interface_type_info; Printing.log_out @@ -150,13 +150,15 @@ let add_class_to_tenv type_ptr_to_sil_type tenv curr_class decl_info class_name let add_missing_methods tenv class_name decl_info decl_list curr_class = let methods = ObjcProperty_decl.get_methods curr_class decl_list in - let class_tn_name = Sil.TN_csu (Sil.Class, (Mangled.from_string class_name)) in + let class_tn_name = Sil.TN_csu (Csu.Class, (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(fields, [], Sil.Class, Some name, superclass, existing_methods, annotation) -> + | Some Sil.Tstruct (fields, [], Csu.Class, Some name, + superclass, existing_methods, annotation) -> let methods = General_utils.append_no_duplicates_methods existing_methods methods in - let typ = Sil.Tstruct(fields, [], Sil.Class, Some name, superclass, methods, annotation) in + let typ = + Sil.Tstruct (fields, [], Csu.Class, Some name, superclass, methods, annotation) in Sil.tenv_add tenv class_tn_name typ | _ -> ()); Sil.Tvar class_tn_name diff --git a/infer/src/clang/objcProtocol_decl.ml b/infer/src/clang/objcProtocol_decl.ml index d59502753..fe279a0f1 100644 --- a/infer/src/clang/objcProtocol_decl.ml +++ b/infer/src/clang/objcProtocol_decl.ml @@ -28,12 +28,12 @@ let protocol_decl type_ptr_to_sil_type tenv decl = (* It may turn out that we need a more specific treatment for protocols*) Printing.log_out "ADDING: ObjCProtocolDecl for '%s'\n" name; let mang_name = Mangled.from_string name in - let protocol_name = Sil.TN_csu (Sil.Protocol, mang_name) in + let protocol_name = Sil.TN_csu (Csu.Protocol, mang_name) in let decl_key = `DeclPtr decl_info.Clang_ast_t.di_pointer in Ast_utils.update_sil_types_map decl_key (Sil.Tvar protocol_name); let methods = ObjcProperty_decl.get_methods curr_class decl_list in let protocol_type_info = - Sil.Tstruct ([], [], Sil.Protocol, Some mang_name, [], methods, []) in + Sil.Tstruct ([], [], Csu.Protocol, Some mang_name, [], methods, []) in Sil.tenv_add tenv protocol_name protocol_type_info; add_protocol_super type_ptr_to_sil_type tenv obj_c_protocol_decl_info; Sil.Tvar protocol_name diff --git a/infer/src/harness/androidFramework.ml b/infer/src/harness/androidFramework.ml index 1bff3183c..39f96508a 100644 --- a/infer/src/harness/androidFramework.ml +++ b/infer/src/harness/androidFramework.ml @@ -253,7 +253,7 @@ let android_callbacks = (* TODO (t4644852): factor out subtyping functions into some sort of JavaUtil module *) let get_all_supertypes typ tenv = let get_direct_supers = function - | Sil.Tstruct (_, _, Sil.Class, _, supers, _, _) -> supers + | Sil.Tstruct (_, _, Csu.Class, _, supers, _, _) -> supers | _ -> [] in let rec add_typ name typs = match Sil.get_typ name None tenv with | Some typ -> get_supers_rec typ tenv (TypSet.add typ typs) @@ -269,7 +269,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.get_typ classname (Some Sil.Class) tenv with + match Sil.get_typ classname (Some Csu.Class) tenv with | Some found_typ -> is_subtype typ found_typ tenv | _ -> false @@ -292,7 +292,7 @@ let is_callback_class_name class_name = Mangled.MangledSet.mem class_name androi let is_callback_class typ tenv = let supertyps = get_all_supertypes typ tenv in TypSet.exists (fun typ -> match typ with - | Sil.Tstruct (_, _, Sil.Class, Some classname, _, _, _) -> + | Sil.Tstruct (_, _, Csu.Class, Some classname, _, _, _) -> is_callback_class_name classname | _ -> false) supertyps @@ -353,7 +353,7 @@ let is_callback_register_method procname args 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.get_typ lifecycle_typ None tenv with - | Some (Sil.Tstruct(_, _, Sil.Class, Some class_name, _, decl_procs, _) as lifecycle_typ) -> + | Some (Sil.Tstruct(_, _, Csu.Class, Some class_name, _, decl_procs, _) 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 -> @@ -377,8 +377,8 @@ let is_runtime_exception tenv exn = let lookup = Sil.tenv_lookup tenv in let runtime_exception_typename = let name = Mangled.from_package_class "java.lang" "RuntimeException" in - Sil.TN_csu (Sil.Class, name) - and exn_typename = Sil.TN_csu (Sil.Class, exn) in + Sil.TN_csu (Csu.Class, name) + and exn_typename = Sil.TN_csu (Csu.Class, exn) in match lookup runtime_exception_typename, lookup exn_typename with | Some runtime_exception_type, Some exn_type -> is_subtype exn_type runtime_exception_type tenv diff --git a/infer/src/harness/harness.ml b/infer/src/harness/harness.ml index 02eeb5a78..f29c5bd9c 100644 --- a/infer/src/harness/harness.ml +++ b/infer/src/harness/harness.ml @@ -118,7 +118,7 @@ let find_registered_callbacks lifecycle_trace harness_name proc_file_map tenv = (** if [typ] is a lifecycle type, generate a list of (method call, receiver) pairs constituting a lifecycle trace *) let try_create_lifecycle_trace typ lifecycle_typ lifecycle_procs proc_file_map tenv = match typ with - | Sil.Tstruct(_, _, Sil.Class, Some class_name, _, methods, _) + | Sil.Tstruct(_, _, Csu.Class, Some class_name, _, methods, _) when AndroidFramework.typ_is_lifecycle_typ typ lifecycle_typ tenv && not (AndroidFramework.is_android_lib_class class_name) -> let ptr_to_typ = Some (Sil.Tptr (typ, Sil.Pk_pointer)) in @@ -140,10 +140,10 @@ let extract_callbacks lifecycle_trace harness_procname proc_file_map tenv = 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 (fields, [], Sil.Class, Some harness_name, [], [harness_procname], []) in + Sil.Tstruct (fields, [], Csu.Class, Some harness_name, [], [harness_procname], []) 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 = Sil.TN_csu (Sil.Class, harness_name) in + let harness_class = Sil.TN_csu (Csu.Class, harness_name) in Sil.tenv_add tenv harness_class harness_typ; let cfgs_to_save = IList.fold_left (fun cfgs_to_save (_, _, instrument_sil_f) -> diff --git a/infer/src/harness/inhabit.ml b/infer/src/harness/inhabit.ml index 2195993a0..a2ae7b043 100644 --- a/infer/src/harness/inhabit.ml +++ b/infer/src/harness/inhabit.ml @@ -108,7 +108,7 @@ let rec inhabit_typ typ proc_file_map env = (* select methods that are constructors and won't force us into infinite recursion because * we are already inhabiting one of their argument types *) let get_all_suitable_constructors typ = match typ with - | Sil.Tstruct (_, _, Sil.Class, _, superclasses, methods, _) -> + | Sil.Tstruct (_, _, Csu.Class, _, superclasses, methods, _) -> let is_suitable_constructor p = let try_get_non_receiver_formals p = try get_non_receiver_formals (formals_from_name p proc_file_map) @@ -205,7 +205,7 @@ let inhabit_fld_trace flds proc_file_map env = Sil.Letderef (lhs, fld_exp, fld_typ, env.pc) in let env = env_add_instr fld_read_instr [lhs] env in match fld_typ with - | Sil.Tptr (Sil.Tstruct (_, _, Sil.Class, _, _, procs, _), _) -> + | Sil.Tptr (Sil.Tstruct (_, _, Csu.Class, _, _, procs, _), _) -> let inhabit_cb_call procname env = try let procdesc = procdesc_from_name procname proc_file_map in diff --git a/infer/src/harness/stacktrace.ml b/infer/src/harness/stacktrace.ml index 6f238372c..91071a88b 100644 --- a/infer/src/harness/stacktrace.ml +++ b/infer/src/harness/stacktrace.ml @@ -42,8 +42,8 @@ let try_resolve_frame str_frame exe_env tenv = (* find the class name in the tenv and get the procedure(s) whose names match the procedure name * in the stack trace. Note that the stack trace does not have any type or argument information; * the name is all that we have to go on *) - match Sil.tenv_lookup tenv (Sil.TN_csu (Sil.Class, class_name)) with - | Some Sil.Tstruct (_, _, Sil.Class, _, _, decl_procs, _) -> + match Sil.tenv_lookup tenv (Sil.TN_csu (Csu.Class, class_name)) with + | Some Sil.Tstruct (_, _, Csu.Class, _, _, decl_procs, _) -> let possible_calls = IList.filter (fun proc -> Procname.java_get_method proc = str_frame.method_str) diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index 660ee05e0..e1663ae47 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -107,7 +107,7 @@ let retrieve_fieldname fieldname = let get_field_name program static tenv cn fs context = match JTransType.get_class_type_no_pointer program tenv cn with - | Sil.Tstruct (fields, sfields, Sil.Class, _, _, _, _) -> + | Sil.Tstruct (fields, sfields, Csu.Class, _, _, _, _) -> let fieldname, _, _ = try IList.find diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index 4bfbdd66d..3427a9cb5 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -59,7 +59,7 @@ let const_type const = let typename_of_classname cn = - Sil.TN_csu (Sil.Class, (Mangled.from_string (JBasics.cn_name cn))) + Sil.TN_csu (Csu.Class, (Mangled.from_string (JBasics.cn_name cn))) let rec get_named_type vt = @@ -91,7 +91,7 @@ let rec create_array_type typ dim = let extract_cn_no_obj typ = match typ with - | Sil.Tptr (Sil.Tstruct (_, _, Sil.Class, Some classname, _, _, _), Sil.Pk_pointer) -> + | Sil.Tptr (Sil.Tstruct (_, _, Csu.Class, Some classname, _, _, _), Sil.Pk_pointer) -> let class_name = (Mangled.to_string classname) in if class_name = JConfig.object_cl then None else @@ -239,7 +239,7 @@ let collect_interface_field cn inf l = let dummy_type cn = let classname = Mangled.from_string (JBasics.cn_name cn) in - Sil.Tstruct ([], [], Sil.Class, Some classname, [], [], Sil.item_annotation_empty) + Sil.Tstruct ([], [], Csu.Class, Some classname, [], [], Sil.item_annotation_empty) let collect_models_class_fields classpath_field_map cn cf fields = @@ -311,7 +311,10 @@ and create_sil_type program tenv cn = match node with | Javalib.JInterface jinterface -> let static_fields, _ = get_all_fields program tenv cn in - let sil_interface_list = IList.map (fun c -> (Sil.Class, c)) (create_super_list jinterface.Javalib.i_interfaces) in + let sil_interface_list = + IList.map + (fun c -> (Csu.Class, c)) + (create_super_list jinterface.Javalib.i_interfaces) in let item_annotation = JAnnotation.translate_item jinterface.Javalib.i_annotations in (sil_interface_list, [], static_fields, item_annotation) | Javalib.JClass jclass -> @@ -330,11 +333,12 @@ and create_sil_type program tenv cn = | _ -> assert false in super_classname :: interface_list in let super_sil_classname_list = - IList.map (fun c -> (Sil.Class, c)) super_classname_list in + IList.map (fun c -> (Csu.Class, c)) super_classname_list in (super_sil_classname_list, nonstatic_fields, static_fields, item_annotation) in let classname = Mangled.from_string (JBasics.cn_name cn) in let method_procnames = get_class_procnames cn node in - Sil.Tstruct (nonstatic_fields, static_fields, Sil.Class, Some classname, super_list, method_procnames, item_annotation) + Sil.Tstruct (nonstatic_fields, static_fields, Csu.Class, + Some classname, super_list, method_procnames, item_annotation) and get_class_type_no_pointer program tenv cn =