From 33352623a533ddd215324e99d8803eaa4d4e423d Mon Sep 17 00:00:00 2001 From: Nikos Gorogiannis Date: Thu, 19 Dec 2019 04:00:31 -0800 Subject: [PATCH] [typ] extract Fieldname from Typ Summary: There is no reason to have this in Typ. Reviewed By: skcho Differential Revision: D19161946 fbshipit-source-id: 7d9b4f249 --- infer/src/IR/AccessPath.ml | 4 +- infer/src/IR/AccessPath.mli | 4 +- infer/src/IR/DecompiledExp.ml | 15 ++--- infer/src/IR/DecompiledExp.mli | 4 +- infer/src/IR/Exceptions.ml | 4 +- infer/src/IR/Exceptions.mli | 2 +- infer/src/IR/Exp.ml | 4 +- infer/src/IR/Exp.mli | 4 +- infer/src/IR/Fieldname.ml | 64 +++++++++++++++++++ infer/src/IR/Fieldname.mli | 45 +++++++++++++ infer/src/IR/HilExp.ml | 16 ++--- infer/src/IR/HilExp.mli | 8 +-- infer/src/IR/Localise.ml | 4 +- infer/src/IR/Localise.mli | 2 +- infer/src/IR/ProcAttributes.ml | 2 +- infer/src/IR/Struct.ml | 9 ++- infer/src/IR/Struct.mli | 8 +-- infer/src/IR/Tenv.ml | 2 +- infer/src/IR/Typ.ml | 57 ----------------- infer/src/IR/Typ.mli | 38 ----------- infer/src/absint/PatternMatch.ml | 8 +-- infer/src/absint/PatternMatch.mli | 2 +- infer/src/backend/errdesc.ml | 24 +++---- infer/src/backend/reporting.mli | 3 +- infer/src/biabduction/Abs.ml | 4 +- infer/src/biabduction/Absarray.ml | 17 +++-- infer/src/biabduction/Dom.ml | 8 +-- infer/src/biabduction/DotBiabduction.ml | 20 +++--- infer/src/biabduction/Match.ml | 6 +- infer/src/biabduction/Predicates.ml | 8 +-- infer/src/biabduction/Predicates.mli | 4 +- infer/src/biabduction/Prop.ml | 12 ++-- infer/src/biabduction/Propgraph.ml | 2 +- infer/src/biabduction/Prover.ml | 15 ++--- infer/src/biabduction/Rearrange.ml | 38 +++++------ infer/src/biabduction/RetainCycles.ml | 6 +- infer/src/biabduction/RetainCyclesType.ml | 13 ++-- infer/src/biabduction/RetainCyclesType.mli | 2 +- infer/src/biabduction/SymExec.ml | 18 +++--- infer/src/biabduction/Tabulation.ml | 6 +- infer/src/bufferoverrun/absLoc.ml | 24 +++---- infer/src/bufferoverrun/absLoc.mli | 10 +-- .../bufferoverrun/bufferOverrunAnalysis.ml | 6 +- infer/src/bufferoverrun/bufferOverrunField.ml | 16 ++--- .../src/bufferoverrun/bufferOverrunField.mli | 14 ++-- .../src/bufferoverrun/bufferOverrunModels.ml | 2 +- .../bufferoverrun/bufferOverrunOndemandEnv.ml | 2 +- .../bufferoverrun/bufferOverrunSemantics.ml | 2 +- infer/src/bufferoverrun/symb.ml | 20 +++--- infer/src/bufferoverrun/symb.mli | 8 +-- infer/src/checkers/NullabilityPreanalysis.ml | 6 +- infer/src/checkers/RequiredProps.ml | 2 +- infer/src/checkers/annotations.ml | 4 +- infer/src/checkers/annotations.mli | 2 +- .../checkers/fragmentRetainsViewChecker.ml | 9 ++- infer/src/clang/cField_decl.ml | 4 +- infer/src/clang/cField_decl.mli | 2 +- infer/src/clang/cGeneral_utils.ml | 4 +- infer/src/clang/cGeneral_utils.mli | 2 +- infer/src/clang/cMethod_trans.ml | 2 +- infer/src/concurrency/RacerD.ml | 4 +- infer/src/concurrency/RacerDModels.ml | 2 +- infer/src/concurrency/StarvationModels.ml | 10 +-- infer/src/java/jTrans.ml | 2 +- infer/src/java/jTransType.ml | 14 ++-- infer/src/java/jTransType.mli | 4 +- infer/src/nullsafe/AnnotatedField.mli | 2 +- infer/src/nullsafe/AssignmentRule.ml | 4 +- infer/src/nullsafe/AssignmentRule.mli | 2 +- infer/src/nullsafe/DereferenceRule.ml | 4 +- infer/src/nullsafe/DereferenceRule.mli | 2 +- infer/src/nullsafe/ErrorRenderingUtils.ml | 6 +- infer/src/nullsafe/NullabilitySuggest.ml | 14 ++-- infer/src/nullsafe/OverAnnotatedRule.ml | 4 +- infer/src/nullsafe/OverAnnotatedRule.mli | 2 +- infer/src/nullsafe/eradicateCheckers.mli | 2 +- infer/src/nullsafe/eradicateChecks.ml | 8 +-- infer/src/nullsafe/typeCheck.ml | 8 +-- infer/src/nullsafe/typeErr.ml | 6 +- infer/src/nullsafe/typeErr.mli | 4 +- infer/src/nullsafe/typeOrigin.ml | 6 +- infer/src/nullsafe/typeOrigin.mli | 2 +- infer/src/pulse/PulseModels.ml | 6 +- infer/src/pulse/PulseOperations.ml | 4 +- infer/src/pulse/PulseOperations.mli | 2 +- infer/src/topl/Topl.ml | 2 +- infer/src/topl/ToplUtils.ml | 2 +- infer/src/topl/ToplUtils.mli | 2 +- infer/src/unit/accessPathTestUtils.ml | 2 +- infer/src/unit/accessPathTestUtils.mli | 2 +- 90 files changed, 392 insertions(+), 395 deletions(-) create mode 100644 infer/src/IR/Fieldname.ml create mode 100644 infer/src/IR/Fieldname.mli diff --git a/infer/src/IR/AccessPath.ml b/infer/src/IR/AccessPath.ml index 018a3715c..100511531 100644 --- a/infer/src/IR/AccessPath.ml +++ b/infer/src/IR/AccessPath.ml @@ -19,7 +19,7 @@ module Raw = struct let equal_base = [%compare.equal: base] - type access = ArrayAccess of typ_ * t list | FieldAccess of Typ.Fieldname.t + type access = ArrayAccess of typ_ * t list | FieldAccess of Fieldname.t and t = base * access list [@@deriving compare] @@ -33,7 +33,7 @@ module Raw = struct let rec pp_access fmt = function | FieldAccess field_name -> - F.pp_print_string fmt (Typ.Fieldname.get_field_name field_name) + F.pp_print_string fmt (Fieldname.get_field_name field_name) | ArrayAccess (typ, []) -> F.pp_print_string fmt "[_]" ; may_pp_typ fmt typ | ArrayAccess (typ, index_aps) -> diff --git a/infer/src/IR/AccessPath.mli b/infer/src/IR/AccessPath.mli index 55d1f53be..c5b6def91 100644 --- a/infer/src/IR/AccessPath.mli +++ b/infer/src/IR/AccessPath.mli @@ -13,7 +13,7 @@ type base = Var.t * Typ.t [@@deriving compare] type access = | ArrayAccess of Typ.t * t list (** array element type with list of access paths in index *) - | FieldAccess of Typ.Fieldname.t (** field name *) + | FieldAccess of Fieldname.t (** field name *) [@@deriving compare] (** root var, and a list of accesses. closest to the root var is first that is, x.f.g is @@ -27,7 +27,7 @@ val truncate : t -> t * access option val get_last_access : t -> access option (** get the last access in the list. returns None if the list is empty *) -val get_field_and_annotation : t -> Tenv.t -> (Typ.Fieldname.t * Annot.Item.t) option +val get_field_and_annotation : t -> Tenv.t -> (Fieldname.t * Annot.Item.t) option (** get the field name and the annotation of the last access in the list of accesses if the list is non-empty and the last access is a field access *) diff --git a/infer/src/IR/DecompiledExp.ml b/infer/src/IR/DecompiledExp.ml index 117c18a0c..54cc13828 100644 --- a/infer/src/IR/DecompiledExp.ml +++ b/infer/src/IR/DecompiledExp.ml @@ -19,8 +19,8 @@ type t = | Dsizeof of Typ.t * t option * Subtype.t | Dderef of t | Dfcall of t * t list * Location.t * CallFlags.t - | Darrow of t * Typ.Fieldname.t - | Ddot of t * Typ.Fieldname.t + | Darrow of t * Fieldname.t + | Ddot of t * Fieldname.t | Dpvar of Pvar.t | Dpvaraddr of Pvar.t | Dunop of Unop.t * t @@ -97,18 +97,17 @@ let rec pp fmt = function F.fprintf fmt "%a%a(%a)" pp_receiver receiver pp_fun fun_dexp pp_args args' | Darrow (Dpvar pv, f) when Pvar.is_this pv -> (* this->fieldname *) - F.pp_print_string fmt (Typ.Fieldname.to_simplified_string f) + F.pp_print_string fmt (Fieldname.to_simplified_string f) | Darrow (de, f) -> if Language.curr_language_is Java then - F.fprintf fmt "%a.%s" pp de (Typ.Fieldname.get_field_name f) - else F.fprintf fmt "%a->%s" pp de (Typ.Fieldname.to_string f) + F.fprintf fmt "%a.%s" pp de (Fieldname.get_field_name f) + else F.fprintf fmt "%a->%s" pp de (Fieldname.to_string f) | Ddot (Dpvar _, fe) when eradicate_java () -> (* static field access *) - F.pp_print_string fmt (Typ.Fieldname.to_simplified_string fe) + F.pp_print_string fmt (Fieldname.to_simplified_string fe) | Ddot (de, f) -> let field_text = - if Language.curr_language_is Java then Typ.Fieldname.get_field_name f - else Typ.Fieldname.to_string f + if Language.curr_language_is Java then Fieldname.get_field_name f else Fieldname.to_string f in F.fprintf fmt "%a.%s" pp de field_text | Dpvar pv -> diff --git a/infer/src/IR/DecompiledExp.mli b/infer/src/IR/DecompiledExp.mli index 326f3bba3..afa9af14d 100644 --- a/infer/src/IR/DecompiledExp.mli +++ b/infer/src/IR/DecompiledExp.mli @@ -19,8 +19,8 @@ type t = | Dsizeof of Typ.t * t option * Subtype.t | Dderef of t | Dfcall of t * t list * Location.t * CallFlags.t - | Darrow of t * Typ.Fieldname.t - | Ddot of t * Typ.Fieldname.t + | Darrow of t * Fieldname.t + | Ddot of t * Fieldname.t | Dpvar of Pvar.t | Dpvaraddr of Pvar.t | Dunop of Unop.t * t diff --git a/infer/src/IR/Exceptions.ml b/infer/src/IR/Exceptions.ml index 2898410eb..9bbcfb44f 100644 --- a/infer/src/IR/Exceptions.ml +++ b/infer/src/IR/Exceptions.ml @@ -88,7 +88,7 @@ exception Java_runtime_exception of Typ.Name.t * string * Localise.error_desc exception Leak of bool * (visibility * Localise.error_desc) * bool * PredSymb.resource * L.ocaml_pos -exception Missing_fld of Typ.Fieldname.t * L.ocaml_pos +exception Missing_fld of Fieldname.t * L.ocaml_pos exception Premature_nil_termination of Localise.error_desc * L.ocaml_pos @@ -404,7 +404,7 @@ let recognize_exception exn = ; severity= None ; category= Prover } | Missing_fld (fld, ocaml_pos) -> - let desc = Localise.verbatim_desc (Typ.Fieldname.to_full_string fld) in + let desc = Localise.verbatim_desc (Fieldname.to_full_string fld) in { name= IssueType.missing_fld ; description= desc ; ocaml_pos= Some ocaml_pos diff --git a/infer/src/IR/Exceptions.mli b/infer/src/IR/Exceptions.mli index 1c6d86b2a..cf2e52c89 100644 --- a/infer/src/IR/Exceptions.mli +++ b/infer/src/IR/Exceptions.mli @@ -90,7 +90,7 @@ exception Java_runtime_exception of Typ.Name.t * string * Localise.error_desc exception Leak of bool * (visibility * Localise.error_desc) * bool * PredSymb.resource * Logging.ocaml_pos -exception Missing_fld of Typ.Fieldname.t * Logging.ocaml_pos +exception Missing_fld of Fieldname.t * Logging.ocaml_pos exception Premature_nil_termination of Localise.error_desc * Logging.ocaml_pos diff --git a/infer/src/IR/Exp.ml b/infer/src/IR/Exp.ml index e87c73bd8..1cb1f2bc0 100644 --- a/infer/src/IR/Exp.ml +++ b/infer/src/IR/Exp.ml @@ -42,7 +42,7 @@ and t = | Const of Const.t (** Constants *) | Cast of Typ.t * t (** Type cast *) | Lvar of Pvar.t (** The address of a program variable *) - | Lfield of t * Typ.Fieldname.t * Typ.t + | Lfield of t * Fieldname.t * Typ.t (** A field offset, the type is the surrounding struct type *) | Lindex of t * t (** An array index offset: [exp1\[exp2\]] *) | Sizeof of sizeof_data @@ -240,7 +240,7 @@ let rec pp_ pe pp_t f e = | Lvar pv -> Pvar.pp pe f pv | Lfield (e, fld, _) -> - F.fprintf f "%a.%a" pp_exp e Typ.Fieldname.pp fld + F.fprintf f "%a.%a" pp_exp e Fieldname.pp fld | Lindex (e1, e2) -> F.fprintf f "%a[%a]" pp_exp e1 pp_exp e2 | Sizeof {typ; nbytes; dynamic_length; subtype} -> diff --git a/infer/src/IR/Exp.mli b/infer/src/IR/Exp.mli index 0e1c2715e..a673aeae9 100644 --- a/infer/src/IR/Exp.mli +++ b/infer/src/IR/Exp.mli @@ -37,7 +37,7 @@ and t = | Const of Const.t (** Constants *) | Cast of Typ.t * t (** Type cast *) | Lvar of Pvar.t (** The address of a program variable *) - | Lfield of t * Typ.Fieldname.t * Typ.t + | Lfield of t * Fieldname.t * Typ.t (** A field offset, the type is the surrounding struct type *) | Lindex of t * t (** An array index offset: [exp1\[exp2\]] *) | Sizeof of sizeof_data @@ -171,5 +171,5 @@ val ignore_cast : t -> t val ignore_integer_cast : t -> t val get_java_class_initializer : - Tenv.t -> t -> (Typ.Procname.t * Pvar.t * Typ.Fieldname.t * Typ.t) option + Tenv.t -> t -> (Typ.Procname.t * Pvar.t * Fieldname.t * Typ.t) option (** Returns the class initializer of the given expression in Java *) diff --git a/infer/src/IR/Fieldname.ml b/infer/src/IR/Fieldname.ml new file mode 100644 index 000000000..cf1dcf069 --- /dev/null +++ b/infer/src/IR/Fieldname.ml @@ -0,0 +1,64 @@ +(* + * Copyright (c) Facebook, Inc. and its affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open! IStd +module F = Format + +type t = {class_name: Typ.Name.t; field_name: string} [@@deriving compare, equal] + +let make class_name field_name = {class_name; field_name} + +let get_class_name {class_name} = class_name + +let get_field_name {field_name} = field_name + +let is_java {class_name} = Typ.Name.Java.is_class class_name + +module T = struct + type nonrec t = t + + let compare = compare +end + +module Set = Caml.Set.Make (T) +module Map = Caml.Map.Make (T) + +let join ~sep c f = String.concat ~sep [c; f] + +let dot_join = join ~sep:"." + +let cc_join = join ~sep:"::" + +let to_string fld = + if is_java fld then dot_join (Typ.Name.name fld.class_name) fld.field_name else fld.field_name + + +let to_simplified_string fld = + if is_java fld then + Typ.Name.name fld.class_name |> String.rsplit2 ~on:'.' + |> Option.value_map ~default:fld.field_name ~f:(fun (_, class_only) -> + String.concat ~sep:"." [class_only; fld.field_name] ) + else fld.field_name + + +let to_full_string fld = + (if is_java fld then dot_join else cc_join) (Typ.Name.name fld.class_name) fld.field_name + + +let pp f fld = F.pp_print_string f fld.field_name + +let is_java_captured_parameter ({field_name} as field) = + is_java field && String.is_prefix ~prefix:"val$" field_name + + +let is_java_outer_instance ({field_name} as field) = + is_java field + && + let this = "this$" in + let last_char = field_name.[String.length field_name - 1] in + (last_char >= '0' && last_char <= '9') + && String.is_suffix field_name ~suffix:(this ^ String.of_char last_char) diff --git a/infer/src/IR/Fieldname.mli b/infer/src/IR/Fieldname.mli new file mode 100644 index 000000000..6efc69457 --- /dev/null +++ b/infer/src/IR/Fieldname.mli @@ -0,0 +1,45 @@ +(* + * Copyright (c) Facebook, Inc. and its affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open! IStd +module F = Format + +(** Names for fields of class/struct/union *) +type t [@@deriving compare, equal] + +val make : Typ.Name.t -> string -> t +(** create a field of the given class and fieldname *) + +val get_class_name : t -> Typ.Name.t + +val get_field_name : t -> string + +val is_java : t -> bool + +module Set : Caml.Set.S with type elt = t +(** Set for fieldnames *) + +module Map : Caml.Map.S with type key = t +(** Map for fieldnames *) + +val is_java_captured_parameter : t -> bool +(** Check if field is a captured parameter *) + +val is_java_outer_instance : t -> bool +(** Check if the field is the synthetic this$n of a nested class, used to access the n-th outer + instance. *) + +val to_string : t -> string +(** Convert a field name to a string. *) + +val to_full_string : t -> string + +val to_simplified_string : t -> string +(** Convert a fieldname to a simplified string with at most one-level path. *) + +val pp : F.formatter -> t -> unit +(** Pretty print a field name. *) diff --git a/infer/src/IR/HilExp.ml b/infer/src/IR/HilExp.ml index 5b5d42ee0..9fb0fd58d 100644 --- a/infer/src/IR/HilExp.ml +++ b/infer/src/IR/HilExp.ml @@ -15,7 +15,7 @@ let compare_typ_ _ _ = 0 module Access = struct type 'array_index t = - | FieldAccess of Typ.Fieldname.t + | FieldAccess of Fieldname.t | ArrayAccess of typ_ * 'array_index | TakeAddress | Dereference @@ -23,7 +23,7 @@ module Access = struct let pp pp_array_index fmt = function | FieldAccess field_name -> - Typ.Fieldname.pp fmt field_name + Fieldname.pp fmt field_name | ArrayAccess (_, index) -> F.fprintf fmt "[%a]" pp_array_index index | TakeAddress -> @@ -55,7 +55,7 @@ module T : sig and access_expression = private | Base of AccessPath.base - | FieldOffset of access_expression * Typ.Fieldname.t + | FieldOffset of access_expression * Fieldname.t | ArrayOffset of access_expression * typ_ * t option | AddressOf of access_expression | Dereference of access_expression @@ -64,7 +64,7 @@ module T : sig module UnsafeAccessExpression : sig val base : AccessPath.base -> access_expression - val field_offset : access_expression -> Typ.Fieldname.t -> access_expression + val field_offset : access_expression -> Fieldname.t -> access_expression val array_offset : access_expression -> Typ.t -> t option -> access_expression @@ -90,7 +90,7 @@ end = struct and access_expression = | Base of AccessPath.base - | FieldOffset of access_expression * Typ.Fieldname.t + | FieldOffset of access_expression * Fieldname.t | ArrayOffset of access_expression * typ_ * t option | AddressOf of access_expression | Dereference of access_expression @@ -149,9 +149,9 @@ let rec pp_access_expr fmt = function | Base (pvar, typ) -> Var.pp fmt pvar ; may_pp_typ fmt typ | FieldOffset (Dereference ae, fld) -> - F.fprintf fmt "%a->%a" pp_access_expr ae Typ.Fieldname.pp fld + F.fprintf fmt "%a->%a" pp_access_expr ae Fieldname.pp fld | FieldOffset (ae, fld) -> - F.fprintf fmt "%a.%a" pp_access_expr ae Typ.Fieldname.pp fld + F.fprintf fmt "%a.%a" pp_access_expr ae Fieldname.pp fld | ArrayOffset (ae, typ, index) -> F.fprintf fmt "%a[%a]%a" pp_access_expr ae (pp_array_offset_opt pp) index may_pp_typ typ | AddressOf (Base _ as ae) -> @@ -215,7 +215,7 @@ module AccessExpression = struct type nonrec t = access_expression = private | Base of AccessPath.base - | FieldOffset of access_expression * Typ.Fieldname.t + | FieldOffset of access_expression * Fieldname.t | ArrayOffset of access_expression * typ_ * t option | AddressOf of access_expression | Dereference of access_expression diff --git a/infer/src/IR/HilExp.mli b/infer/src/IR/HilExp.mli index 240cc0122..f2907bd3c 100644 --- a/infer/src/IR/HilExp.mli +++ b/infer/src/IR/HilExp.mli @@ -10,7 +10,7 @@ module F = Format module Access : sig type 'array_index t = - | FieldAccess of Typ.Fieldname.t + | FieldAccess of Fieldname.t | ArrayAccess of Typ.t * 'array_index | TakeAddress | Dereference @@ -36,7 +36,7 @@ type t = and access_expression = private | Base of AccessPath.base - | FieldOffset of access_expression * Typ.Fieldname.t (** field access *) + | FieldOffset of access_expression * Fieldname.t (** field access *) | ArrayOffset of access_expression * Typ.t * t option (** array access *) | AddressOf of access_expression (** "address of" operator [&] *) | Dereference of access_expression (** "dereference" operator [*] *) @@ -47,7 +47,7 @@ module AccessExpression : sig val base : AccessPath.base -> access_expression - val field_offset : access_expression -> Typ.Fieldname.t -> access_expression + val field_offset : access_expression -> Fieldname.t -> access_expression val array_offset : access_expression -> Typ.t -> t option -> access_expression @@ -92,7 +92,7 @@ module AccessExpression : sig type nonrec t = access_expression = private | Base of AccessPath.base - | FieldOffset of access_expression * Typ.Fieldname.t + | FieldOffset of access_expression * Fieldname.t | ArrayOffset of access_expression * Typ.t * t option | AddressOf of access_expression | Dereference of access_expression diff --git a/infer/src/IR/Localise.ml b/infer/src/IR/Localise.ml index 8d651e39f..41168ca8d 100644 --- a/infer/src/IR/Localise.ml +++ b/infer/src/IR/Localise.ml @@ -311,7 +311,7 @@ let deref_str_array_bound size_opt index_opt = let desc_unsafe_guarded_by_access accessed_fld guarded_by_str loc = let line_info = at_line (Tags.create ()) loc in - let accessed_fld_str = Typ.Fieldname.to_string accessed_fld in + let accessed_fld_str = Fieldname.to_string accessed_fld in let annot_str = Printf.sprintf "@GuardedBy(\"%s\")" guarded_by_str in let syncronized_str = MF.monospaced_to_string (Printf.sprintf "synchronized(%s)" guarded_by_str) @@ -424,7 +424,7 @@ let parameter_field_not_null_checked_desc (desc : error_desc) exp = let rec exp_to_string exp = match exp with | Exp.Lfield (exp', field, _) -> - exp_to_string exp' ^ " -> " ^ Typ.Fieldname.to_string field + exp_to_string exp' ^ " -> " ^ Fieldname.to_string field | Exp.Lvar pvar -> Mangled.to_string (Pvar.get_name pvar) | _ -> diff --git a/infer/src/IR/Localise.mli b/infer/src/IR/Localise.mli index d2fc1f084..814fa86b2 100644 --- a/infer/src/IR/Localise.mli +++ b/infer/src/IR/Localise.mli @@ -160,7 +160,7 @@ val desc_inherently_dangerous_function : Typ.Procname.t -> error_desc val desc_unary_minus_applied_to_unsigned_expression : string option -> string -> Location.t -> error_desc -val desc_unsafe_guarded_by_access : Typ.Fieldname.t -> string -> Location.t -> error_desc +val desc_unsafe_guarded_by_access : Fieldname.t -> string -> Location.t -> error_desc val desc_uninitialized_dangling_pointer_deref : deref_str -> string -> Location.t -> error_desc diff --git a/infer/src/IR/ProcAttributes.ml b/infer/src/IR/ProcAttributes.ml index 4ac36c922..b2abcf5d0 100644 --- a/infer/src/IR/ProcAttributes.ml +++ b/infer/src/IR/ProcAttributes.ml @@ -24,7 +24,7 @@ let pp_objc_accessor_type fmt objc_accessor_type = in F.fprintf fmt "%s<%a:%a@,[%a]>" (kind_of_objc_accessor_type objc_accessor_type) - Typ.Fieldname.pp fieldname (Typ.pp Pp.text) typ + Fieldname.pp fieldname (Typ.pp Pp.text) typ (Pp.semicolon_seq ~print_env:Pp.text_break (Pp.pair ~fst:Annot.pp ~snd:F.pp_print_bool)) annots diff --git a/infer/src/IR/Struct.ml b/infer/src/IR/Struct.ml index 3ff8def02..b2f94cac4 100644 --- a/infer/src/IR/Struct.ml +++ b/infer/src/IR/Struct.ml @@ -8,7 +8,7 @@ open! IStd module F = Format -type field = Typ.Fieldname.t * Typ.t * Annot.Item.t [@@deriving compare] +type field = Fieldname.t * Typ.t * Annot.Item.t [@@deriving compare] type fields = field list @@ -26,7 +26,7 @@ type t = type lookup = Typ.Name.t -> t option let pp_field pe f (field_name, typ, ann) = - F.fprintf f "@\n\t\t%a %a %a" (Typ.pp_full pe) typ Typ.Fieldname.pp field_name Annot.Item.pp ann + F.fprintf f "@\n\t\t%a %a %a" (Typ.pp_full pe) typ Fieldname.pp field_name Annot.Item.pp ann let pp pe name f {fields; supers; methods; exported_objc_methods; annots} = @@ -102,7 +102,7 @@ let fld_typ ~lookup ~default fn (typ : Typ.t) = | Tstruct name -> ( match lookup name with | Some {fields} -> - List.find ~f:(fun (f, _, _) -> Typ.Fieldname.equal f fn) fields + List.find ~f:(fun (f, _, _) -> Fieldname.equal f fn) fields |> Option.value_map ~f:snd3 ~default | None -> default ) @@ -115,8 +115,7 @@ type field_info = {typ: Typ.t; annotations: Annot.Item.t; is_static: bool} let find_field field_list field_name_to_lookup = List.find_map ~f:(fun (field_name, typ, annotations) -> - if Typ.Fieldname.equal field_name field_name_to_lookup then Some (typ, annotations) else None - ) + if Fieldname.equal field_name field_name_to_lookup then Some (typ, annotations) else None ) field_list diff --git a/infer/src/IR/Struct.mli b/infer/src/IR/Struct.mli index 79c562574..e030a2671 100644 --- a/infer/src/IR/Struct.mli +++ b/infer/src/IR/Struct.mli @@ -9,7 +9,7 @@ open! IStd module F = Format -type field = Typ.Fieldname.t * Typ.t * Annot.Item.t [@@deriving compare] +type field = Fieldname.t * Typ.t * Annot.Item.t [@@deriving compare] type fields = field list @@ -49,15 +49,15 @@ val get_extensible_array_element_typ : lookup:lookup -> Typ.t -> Typ.t option type field_info = {typ: Typ.t; annotations: Annot.Item.t; is_static: bool} -val get_field_info : lookup:lookup -> Typ.Fieldname.t -> Typ.t -> field_info option +val get_field_info : lookup:lookup -> Fieldname.t -> Typ.t -> field_info option (** Lookup for info associated with the field [fn]. None if [typ] has no field named [fn] *) -val fld_typ : lookup:lookup -> default:Typ.t -> Typ.Fieldname.t -> Typ.t -> Typ.t +val fld_typ : lookup:lookup -> default:Typ.t -> Fieldname.t -> Typ.t -> Typ.t (** If a struct type with field f, return the type of f. If not, return the default type if given, otherwise raise an exception *) val get_field_type_and_annotation : - lookup:lookup -> Typ.Fieldname.t -> Typ.t -> (Typ.t * Annot.Item.t) option + lookup:lookup -> Fieldname.t -> Typ.t -> (Typ.t * Annot.Item.t) option (** Return the type of the field [fn] and its annotation, None if [typ] has no field named [fn] *) val is_dummy : t -> bool diff --git a/infer/src/IR/Tenv.ml b/infer/src/IR/Tenv.ml index 5b9b640cd..722912c76 100644 --- a/infer/src/IR/Tenv.ml +++ b/infer/src/IR/Tenv.ml @@ -53,7 +53,7 @@ let lookup tenv name : Struct.t option = None ) -let compare_fields (name1, _, _) (name2, _, _) = Typ.Fieldname.compare name1 name2 +let compare_fields (name1, _, _) (name2, _, _) = Fieldname.compare name1 name2 let equal_fields f1 f2 = Int.equal (compare_fields f1 f2) 0 diff --git a/infer/src/IR/Typ.ml b/infer/src/IR/Typ.ml index db909e77e..aa9174ba9 100644 --- a/infer/src/IR/Typ.ml +++ b/infer/src/IR/Typ.ml @@ -1420,60 +1420,3 @@ module Procname = struct type nonrec t = t list end) end - -module Fieldname = struct - type t = {class_name: Name.t; field_name: string} [@@deriving compare, equal] - - let make class_name field_name = {class_name; field_name} - - let get_class_name {class_name} = class_name - - let get_field_name {field_name} = field_name - - let is_java {class_name} = Name.Java.is_class class_name - - module T = struct - type nonrec t = t - - let compare = compare - end - - module Set = Caml.Set.Make (T) - module Map = Caml.Map.Make (T) - - let join ~sep c f = String.concat ~sep [c; f] - - let dot_join = join ~sep:"." - - let cc_join = join ~sep:"::" - - let to_string fld = - if is_java fld then dot_join (Name.name fld.class_name) fld.field_name else fld.field_name - - - let to_simplified_string fld = - if is_java fld then - Name.name fld.class_name |> String.rsplit2 ~on:'.' - |> Option.value_map ~default:fld.field_name ~f:(fun (_, class_only) -> - String.concat ~sep:"." [class_only; fld.field_name] ) - else fld.field_name - - - let to_full_string fld = - (if is_java fld then dot_join else cc_join) (Name.name fld.class_name) fld.field_name - - - let pp f fld = F.pp_print_string f fld.field_name - - let is_java_captured_parameter ({field_name} as field) = - is_java field && String.is_prefix ~prefix:"val$" field_name - - - let is_java_outer_instance ({field_name} as field) = - is_java field - && - let this = "this$" in - let last_char = field_name.[String.length field_name - 1] in - (last_char >= '0' && last_char <= '9') - && String.is_suffix field_name ~suffix:(this ^ String.of_char last_char) -end diff --git a/infer/src/IR/Typ.mli b/infer/src/IR/Typ.mli index e2b15fbba..24e3fb43e 100644 --- a/infer/src/IR/Typ.mli +++ b/infer/src/IR/Typ.mli @@ -634,41 +634,3 @@ being the name of the struct, [None] means the parameter is of some other type. val get_qualifiers : t -> QualifiedCppName.t (** get qualifiers of C/objc/C++ method/function *) end - -module Fieldname : sig - (** Names for fields of class/struct/union *) - type t [@@deriving compare, equal] - - val make : Name.t -> string -> t - (** create a field of the given class and fieldname *) - - val get_class_name : t -> Name.t - - val get_field_name : t -> string - - val is_java : t -> bool - - module Set : Caml.Set.S with type elt = t - (** Set for fieldnames *) - - module Map : Caml.Map.S with type key = t - (** Map for fieldnames *) - - val is_java_captured_parameter : t -> bool - (** Check if field is a captured parameter *) - - val is_java_outer_instance : t -> bool - (** Check if the field is the synthetic this$n of a nested class, used to access the n-th outer - instance. *) - - val to_string : t -> string - (** Convert a field name to a string. *) - - val to_full_string : t -> string - - val to_simplified_string : t -> string - (** Convert a fieldname to a simplified string with at most one-level path. *) - - val pp : Format.formatter -> t -> unit - (** Pretty print a field name. *) -end diff --git a/infer/src/absint/PatternMatch.ml b/infer/src/absint/PatternMatch.ml index d35181458..bf906f117 100644 --- a/infer/src/absint/PatternMatch.ml +++ b/infer/src/absint/PatternMatch.ml @@ -138,12 +138,12 @@ let rec get_type_name {Typ.desc} = "_" -let get_field_type_name tenv (typ : Typ.t) (fieldname : Typ.Fieldname.t) : string option = +let get_field_type_name tenv (typ : Typ.t) (fieldname : Fieldname.t) : string option = match typ.desc with | Tstruct name | Tptr ({desc= Tstruct name}, _) -> ( match Tenv.lookup tenv name with | Some {fields} -> ( - match List.find ~f:(function fn, _, _ -> Typ.Fieldname.equal fn fieldname) fields with + match List.find ~f:(function fn, _, _ -> Fieldname.equal fn fieldname) fields with | Some (_, ft, _) -> Some (get_type_name ft) | None -> @@ -400,7 +400,7 @@ let get_fields_nullified procdesc = let collect_nullified_flds (nullified_flds, this_ids) _ = function | Sil.Store {e1= Exp.Lfield (Exp.Var lhs, fld, _); e2= rhs} when Exp.is_null_literal rhs && Ident.Set.mem lhs this_ids -> - (Typ.Fieldname.Set.add fld nullified_flds, this_ids) + (Fieldname.Set.add fld nullified_flds, this_ids) | Sil.Load {id; e= rhs} when Exp.is_this rhs -> (nullified_flds, Ident.Set.add id this_ids) | _ -> @@ -408,7 +408,7 @@ let get_fields_nullified procdesc = in let nullified_flds, _ = Procdesc.fold_instrs procdesc ~f:collect_nullified_flds - ~init:(Typ.Fieldname.Set.empty, Ident.Set.empty) + ~init:(Fieldname.Set.empty, Ident.Set.empty) in nullified_flds diff --git a/infer/src/absint/PatternMatch.mli b/infer/src/absint/PatternMatch.mli index aabb8ccba..f7fd04a8d 100644 --- a/infer/src/absint/PatternMatch.mli +++ b/infer/src/absint/PatternMatch.mli @@ -130,7 +130,7 @@ val type_get_class_name : Typ.t -> Typ.Name.t option val type_is_class : Typ.t -> bool (** Is the type a class type *) -val get_fields_nullified : Procdesc.t -> Typ.Fieldname.Set.t +val get_fields_nullified : Procdesc.t -> Fieldname.Set.t (** return the set of instance fields that are assigned to a null literal in [procdesc] *) val is_throwable : Tenv.t -> Typ.Name.t -> bool diff --git a/infer/src/backend/errdesc.ml b/infer/src/backend/errdesc.ml index 0934192fc..c4132d5eb 100644 --- a/infer/src/backend/errdesc.ml +++ b/infer/src/backend/errdesc.ml @@ -32,7 +32,7 @@ let is_method_of_objc_cpp_class pname matcher = let is_vector_method pname = is_method_of_objc_cpp_class pname vector_matcher let is_special_field matcher field_name_opt field = - let field_name = Typ.Fieldname.get_field_name field in + let field_name = Fieldname.get_field_name field in let field_ok = match field_name_opt with | Some field_name' -> @@ -41,8 +41,8 @@ let is_special_field matcher field_name_opt field = true in field_ok - && (not (Typ.Fieldname.is_java field)) - && Typ.Fieldname.get_class_name field |> Typ.Name.qual_name |> is_one_of_classes matcher + && (not (Fieldname.is_java field)) + && Fieldname.get_class_name field |> Typ.Name.qual_name |> is_one_of_classes matcher (** Check whether the hpred is a |-> representing a resource in the Racquire state *) @@ -268,7 +268,7 @@ and exp_lv_dexp_ tenv (seen_ : Exp.Set.t) node e : DExp.t option = if verbose then ( L.d_str "exp_lv_dexp: Lfield with var " ; Exp.d_exp (Exp.Var id) ; - L.d_printfln " %a" Typ.Fieldname.pp f ) ; + L.d_printfln " %a" Fieldname.pp f ) ; match find_normal_variable_load_ tenv seen node id with | None -> None @@ -276,9 +276,7 @@ and exp_lv_dexp_ tenv (seen_ : Exp.Set.t) node e : DExp.t option = Some (DExp.Darrow (de, f)) ) | Exp.Lfield (e1, f, _) -> ( if verbose then ( - L.d_str "exp_lv_dexp: Lfield " ; - Exp.d_exp e1 ; - L.d_printfln " %a" Typ.Fieldname.pp f ) ; + L.d_str "exp_lv_dexp: Lfield " ; Exp.d_exp e1 ; L.d_printfln " %a" Fieldname.pp f ) ; match exp_lv_dexp_ tenv seen node e1 with | None -> None @@ -332,9 +330,7 @@ and exp_rv_dexp_ tenv (seen_ : Exp.Set.t) node e : DExp.t option = find_normal_variable_load_ tenv seen node id | Exp.Lfield (e1, f, _) -> ( if verbose then ( - L.d_str "exp_rv_dexp: Lfield " ; - Exp.d_exp e1 ; - L.d_printfln " %a" Typ.Fieldname.pp f ) ; + L.d_str "exp_rv_dexp: Lfield " ; Exp.d_exp e1 ; L.d_printfln " %a" Fieldname.pp f ) ; match exp_rv_dexp_ tenv seen node e1 with | None -> None @@ -583,7 +579,7 @@ let vpath_find tenv prop exp_ : DExp.t option * Typ.t option = | Exp.Sizeof {typ= {Typ.desc= Tstruct name}} -> ( match Tenv.lookup tenv name with | Some {fields} -> - List.find ~f:(fun (f', _, _) -> Typ.Fieldname.equal f' f) fields + List.find ~f:(fun (f', _, _) -> Fieldname.equal f' f) fields |> Option.map ~f:snd3 | _ -> None ) @@ -719,10 +715,10 @@ let explain_dexp_access prop dexp is_nullable = let rec lookup_fld fsel f = match fsel with | [] -> - if verbose then L.d_printfln "lookup_fld: can't find field %a" Typ.Fieldname.pp f ; + if verbose then L.d_printfln "lookup_fld: can't find field %a" Fieldname.pp f ; None | (f1, se) :: fsel' -> - if Typ.Fieldname.equal f1 f then Some se else lookup_fld fsel' f + if Fieldname.equal f1 f then Some se else lookup_fld fsel' f in let rec lookup_esel esel e = match esel with @@ -1016,7 +1012,7 @@ type pvar_off = (* value of a pvar *) | Fpvar (* value obtained by dereferencing the pvar and following a sequence of fields *) - | Fstruct of Typ.Fieldname.t list + | Fstruct of Fieldname.t list let dexp_apply_pvar_off dexp pvar_off = let rec add_ddot de = function [] -> de | f :: fl -> add_ddot (DExp.Ddot (de, f)) fl in diff --git a/infer/src/backend/reporting.mli b/infer/src/backend/reporting.mli index a51f7bd61..e1e9abbc0 100644 --- a/infer/src/backend/reporting.mli +++ b/infer/src/backend/reporting.mli @@ -54,6 +54,5 @@ val log_issue_external : -> IssueLog.t (** Log an issue to the error log in [IssueLog] associated with the given procname. *) -val is_suppressed : - ?field_name:Typ.Fieldname.t option -> Tenv.t -> Procdesc.t -> IssueType.t -> bool +val is_suppressed : ?field_name:Fieldname.t option -> Tenv.t -> Procdesc.t -> IssueType.t -> bool (** should an issue report be suppressed due to a [@SuppressLint("issue")] annotation? *) diff --git a/infer/src/biabduction/Abs.ml b/infer/src/biabduction/Abs.ml index 45106d9ff..b7505bedf 100644 --- a/infer/src/biabduction/Abs.ml +++ b/infer/src/biabduction/Abs.ml @@ -542,7 +542,7 @@ let discover_para_candidates tenv p = let edges = ref [] in let add_edge edg = edges := edg :: !edges in let get_edges_strexp rec_flds root se = - let is_rec_fld fld = List.exists ~f:(Typ.Fieldname.equal fld) rec_flds in + let is_rec_fld fld = List.exists ~f:(Fieldname.equal fld) rec_flds in match se with | Predicates.Eexp _ | Predicates.Earray _ -> () @@ -584,7 +584,7 @@ let discover_para_dll_candidates tenv p = let edges = ref [] in let add_edge edg = edges := edg :: !edges in let get_edges_strexp rec_flds root se = - let is_rec_fld fld = List.exists ~f:(Typ.Fieldname.equal fld) rec_flds in + let is_rec_fld fld = List.exists ~f:(Fieldname.equal fld) rec_flds in match se with | Predicates.Eexp _ | Predicates.Earray _ -> () diff --git a/infer/src/biabduction/Absarray.ml b/infer/src/biabduction/Absarray.ml index 70df17067..ff53b7f93 100644 --- a/infer/src/biabduction/Absarray.ml +++ b/infer/src/biabduction/Absarray.ml @@ -64,7 +64,7 @@ module StrexpMatch : sig (** Replace the index in the array at a given position with the new index *) end = struct (** syntactic offset *) - type syn_offset = Field of Typ.Fieldname.t * Typ.t | Index of Exp.t + type syn_offset = Field of Fieldname.t * Typ.t | Index of Exp.t (** path through an Estruct *) type path = Exp.t * syn_offset list @@ -87,8 +87,8 @@ end = struct | Predicates.Estruct (fsel, _), Tstruct name, Field (fld, _) :: syn_offs' -> ( match Tenv.lookup tenv name with | Some {fields} -> - let se' = snd (List.find_exn ~f:(fun (f', _) -> Typ.Fieldname.equal f' fld) fsel) in - let t' = snd3 (List.find_exn ~f:(fun (f', _, _) -> Typ.Fieldname.equal f' fld) fields) in + let se' = snd (List.find_exn ~f:(fun (f', _) -> Fieldname.equal f' fld) fsel) in + let t' = snd3 (List.find_exn ~f:(fun (f', _, _) -> Fieldname.equal f' fld) fields) in get_strexp_at_syn_offsets tenv se' t' syn_offs' | None -> fail () ) @@ -107,16 +107,15 @@ end = struct | Predicates.Estruct (fsel, inst), Tstruct name, Field (fld, _) :: syn_offs' -> ( match Tenv.lookup tenv name with | Some {fields} -> - let se' = snd (List.find_exn ~f:(fun (f', _) -> Typ.Fieldname.equal f' fld) fsel) in + let se' = snd (List.find_exn ~f:(fun (f', _) -> Fieldname.equal f' fld) fsel) in let t' = (fun (_, y, _) -> y) - (List.find_exn ~f:(fun (f', _, _) -> Typ.Fieldname.equal f' fld) fields) + (List.find_exn ~f:(fun (f', _, _) -> Fieldname.equal f' fld) fields) in let se_mod = replace_strexp_at_syn_offsets tenv se' t' syn_offs' update in let fsel' = List.map - ~f:(fun (f'', se'') -> - if Typ.Fieldname.equal f'' fld then (fld, se_mod) else (f'', se'') ) + ~f:(fun (f'', se'') -> if Fieldname.equal f'' fld then (fld, se_mod) else (f'', se'')) fsel in Predicates.Estruct (fsel', inst) @@ -197,11 +196,11 @@ end = struct | [] -> () | (f, se) :: fsel' -> - ( match List.find ~f:(fun (f', _, _) -> Typ.Fieldname.equal f' f) ftal with + ( match List.find ~f:(fun (f', _, _) -> Fieldname.equal f' f) ftal with | Some (_, t, _) -> find_offset_sexp sigma_other hpred root (Field (f, typ) :: offs) se t | None -> - L.d_printfln "Can't find field %a in StrexpMatch.find" Typ.Fieldname.pp f ) ; + L.d_printfln "Can't find field %a in StrexpMatch.find" Fieldname.pp f ) ; find_offset_fsel sigma_other hpred root offs fsel' ftal typ and find_offset_esel sigma_other hpred root offs esel t = match esel with diff --git a/infer/src/biabduction/Dom.ml b/infer/src/biabduction/Dom.ml index a53bbeb89..39fe82c74 100644 --- a/infer/src/biabduction/Dom.ml +++ b/infer/src/biabduction/Dom.ml @@ -1023,7 +1023,7 @@ let rec exp_partial_join (e1 : Exp.t) (e2 : Exp.t) : Exp.t = L.d_strln "failure reason 25" ; raise Predicates.JoinFail ) else e1 | Exp.Lfield (e1, f1, t1), Exp.Lfield (e2, f2, _) -> - if not (Typ.Fieldname.equal f1 f2) then ( + if not (Fieldname.equal f1 f2) then ( L.d_strln "failure reason 26" ; raise Predicates.JoinFail ) else Exp.Lfield (exp_partial_join e1 e2, f1, t1) (* should be t1 = t2 *) | Exp.Lindex (e1, e1'), Exp.Lindex (e2, e2') -> @@ -1133,7 +1133,7 @@ let rec exp_partial_meet (e1 : Exp.t) (e2 : Exp.t) : Exp.t = L.d_strln "failure reason 35" ; raise Predicates.JoinFail ) else e1 | Exp.Lfield (e1, f1, t1), Exp.Lfield (e2, f2, _) -> - if not (Typ.Fieldname.equal f1 f2) then ( + if not (Fieldname.equal f1 f2) then ( L.d_strln "failure reason 36" ; raise Predicates.JoinFail ) else Exp.Lfield (exp_partial_meet e1 e2, f1, t1) (* should be t1 = t2 *) | Exp.Lindex (e1, e1'), Exp.Lindex (e2, e2') -> @@ -1163,7 +1163,7 @@ let rec strexp_partial_join mode (strexp1 : Predicates.strexp) (strexp2 : Predic | JoinState.Post -> Predicates.Estruct (List.rev acc, inst) ) | (fld1, se1) :: fld_se_list1', (fld2, se2) :: fld_se_list2' -> ( - let comparison = Typ.Fieldname.compare fld1 fld2 in + let comparison = Fieldname.compare fld1 fld2 in if Int.equal comparison 0 then let strexp' = strexp_partial_join mode se1 se2 in let fld_se_list_new = (fld1, strexp') :: acc in @@ -1225,7 +1225,7 @@ let rec strexp_partial_meet (strexp1 : Predicates.strexp) (strexp2 : Predicates. | _, [] -> Predicates.Estruct (construct Lhs acc fld_se_list1, inst) | (fld1, se1) :: fld_se_list1', (fld2, se2) :: fld_se_list2' -> - let comparison = Typ.Fieldname.compare fld1 fld2 in + let comparison = Fieldname.compare fld1 fld2 in if comparison < 0 then let se' = strexp_construct_fresh Lhs se1 in let acc_new = (fld1, se') :: acc in diff --git a/infer/src/biabduction/DotBiabduction.ml b/infer/src/biabduction/DotBiabduction.ml index 0025de884..7a5901490 100644 --- a/infer/src/biabduction/DotBiabduction.ml +++ b/infer/src/biabduction/DotBiabduction.ml @@ -53,7 +53,7 @@ type dotty_node = (* Dotpointsto(coo,e,c): basic memory cell box for expression e at coordinate coo and color c *) | Dotpointsto of coordinate * Exp.t * string (* Dotstruct(coo,e,l,c): struct box for expression e with field list l at coordinate coo and color c *) - | Dotstruct of coordinate * Exp.t * (Typ.Fieldname.t * Predicates.strexp) list * string * Exp.t + | Dotstruct of coordinate * Exp.t * (Fieldname.t * Predicates.strexp) list * string * Exp.t (* Dotarray(coo,e1,e2,l,t,c): array box for expression e1 with field list l at coordinate coo and color c*) (* e2 is the len and t is the type *) | Dotarray of coordinate * Exp.t * Exp.t * (Exp.t * Predicates.strexp) list * Typ.t * string @@ -151,11 +151,11 @@ and struct_to_dotty_str pe coo f ls : unit = | [] -> () | [(fn, se)] -> - F.fprintf f "{ <%s%iL%i> %s: %a } " (Typ.Fieldname.to_string fn) coo.id coo.lambda - (Typ.Fieldname.to_string fn) (strexp_to_string pe coo) se + F.fprintf f "{ <%s%iL%i> %s: %a } " (Fieldname.to_string fn) coo.id coo.lambda + (Fieldname.to_string fn) (strexp_to_string pe coo) se | (fn, se) :: ls' -> - F.fprintf f " { <%s%iL%i> %s: %a } | %a" (Typ.Fieldname.to_string fn) coo.id coo.lambda - (Typ.Fieldname.to_string fn) (strexp_to_string pe coo) se (struct_to_dotty_str pe coo) ls' + F.fprintf f " { <%s%iL%i> %s: %a } | %a" (Fieldname.to_string fn) coo.id coo.lambda + (Fieldname.to_string fn) (strexp_to_string pe coo) se (struct_to_dotty_str pe coo) ls' and get_contents_sexp pe coo f se = @@ -456,7 +456,7 @@ let in_cycle cycle edge = | Some cycle' -> let fn, se = edge in List.exists - ~f:(fun (_, fn', se') -> Typ.Fieldname.equal fn fn' && Predicates.equal_strexp se se') + ~f:(fun (_, fn', se') -> Fieldname.equal fn fn' && Predicates.equal_strexp se se') cycle' | _ -> false @@ -478,7 +478,7 @@ let rec compute_target_struct_fields dotnodes list_fld p f lambda cycle = | Eexp (e, _) -> ( if is_nil e p then let n' = make_nil_node lambda in - if !print_full_prop then [(LinkStructToExp, Typ.Fieldname.to_string fn, n', "")] else [] + if !print_full_prop then [(LinkStructToExp, Fieldname.to_string fn, n', "")] else [] else let nodes_e = select_nodes_exp_lambda dotnodes e lambda in match nodes_e with @@ -487,7 +487,7 @@ let rec compute_target_struct_fields dotnodes list_fld p f lambda cycle = | None -> [] | Some n' -> - [(LinkStructToExp, Typ.Fieldname.to_string fn, n', "")] ) + [(LinkStructToExp, Fieldname.to_string fn, n', "")] ) | [node] | [Dotpointsto _; node] | [node; Dotpointsto _] -> let n = get_coordinate_id node in if List.mem ~equal:Exp.equal !struct_exp_nodes e then @@ -496,8 +496,8 @@ let rec compute_target_struct_fields dotnodes list_fld p f lambda cycle = if in_cycle cycle (fn, se) && not !print_full_prop then LinkRetainCycle else LinkStructToStruct in - [(link_kind, Typ.Fieldname.to_string fn, n, e_no_special_char)] - else [(LinkStructToExp, Typ.Fieldname.to_string fn, n, "")] + [(link_kind, Fieldname.to_string fn, n, e_no_special_char)] + else [(LinkStructToExp, Fieldname.to_string fn, n, "")] | _ -> (* by construction there must be at most 2 nodes for an expression*) L.internal_error "@\n Too many nodes! Error! @\n@." ; diff --git a/infer/src/biabduction/Match.ml b/infer/src/biabduction/Match.ml index a506647db..e5f351b53 100644 --- a/infer/src/biabduction/Match.ml +++ b/infer/src/biabduction/Match.ml @@ -67,7 +67,7 @@ let rec exp_match e1 sub vars e2 : (Predicates.subst * Ident.t list) option = check_equal sub vars e1 e2 | Exp.Lvar _, _ | _, Exp.Lvar _ -> check_equal sub vars e1 e2 - | Exp.Lfield (e1', fld1, _), Exp.Lfield (e2', fld2, _) when Typ.Fieldname.equal fld1 fld2 -> + | Exp.Lfield (e1', fld1, _), Exp.Lfield (e2', fld2, _) when Fieldname.equal fld1 fld2 -> exp_match e1' sub vars e2' | Exp.Lfield _, _ | _, Exp.Lfield _ -> None @@ -128,7 +128,7 @@ and fsel_match fsel1 sub vars fsel2 = if Config.abs_struct <= 0 then None else Some (sub, vars) (* This can lead to great information loss *) | (fld1, se1') :: fsel1', (fld2, se2') :: fsel2' -> - let n = Typ.Fieldname.compare fld1 fld2 in + let n = Fieldname.compare fld1 fld2 in if Int.equal n 0 then match strexp_match se1' sub vars se2' with | None -> @@ -600,7 +600,7 @@ and generate_todos_from_fel mode todos fel1 fel2 = | _, [] -> if equal_iso_mode mode LFieldForget then Some todos else None | (fld1, strexp1) :: fel1', (fld2, strexp2) :: fel2' -> - let n = Typ.Fieldname.compare fld1 fld2 in + let n = Fieldname.compare fld1 fld2 in if Int.equal n 0 then match generate_todos_from_strexp mode todos strexp1 strexp2 with | None -> diff --git a/infer/src/biabduction/Predicates.ml b/infer/src/biabduction/Predicates.ml index f3944dafb..f8535a107 100644 --- a/infer/src/biabduction/Predicates.ml +++ b/infer/src/biabduction/Predicates.ml @@ -11,7 +11,7 @@ module F = Format module L = Logging (** offset for an lvalue *) -type offset = Off_fld of Typ.Fieldname.t * Typ.t | Off_index of Exp.t +type offset = Off_fld of Fieldname.t * Typ.t | Off_index of Exp.t (** {2 Components of Propositions} *) @@ -68,7 +68,7 @@ let equal_inst = [%compare.equal: inst] (** structured expressions represent a value of structured type, such as an array or a struct. *) type 'inst strexp0 = | Eexp of Exp.t * 'inst (** Base case: expression with instrumentation *) - | Estruct of (Typ.Fieldname.t * 'inst strexp0) list * 'inst (** C structure *) + | Estruct of (Fieldname.t * 'inst strexp0) list * 'inst (** C structure *) | Earray of Exp.t * (Exp.t * 'inst strexp0) list * 'inst (** Array of given length There are two conditions imposed / used in the array case. First, if some index and value pair appears inside an array in a strexp, then the index is less than @@ -152,7 +152,7 @@ end) (** Pretty print an offset *) let pp_offset pe f = function | Off_fld (fld, _) -> - Typ.Fieldname.pp f fld + Fieldname.pp f fld | Off_index exp -> (Exp.pp_diff pe) f exp @@ -530,7 +530,7 @@ let rec pp_sexp_env pe0 envo f se = | Eexp (e, inst) -> F.fprintf f "%a%a" (Exp.pp_diff pe) e (pp_inst_if_trace pe) inst | Estruct (fel, inst) -> - let pp_diff f (n, se) = F.fprintf f "%a:%a" Typ.Fieldname.pp n (pp_sexp_env pe envo) se in + let pp_diff f (n, se) = F.fprintf f "%a:%a" Fieldname.pp n (pp_sexp_env pe envo) se in F.fprintf f "{%a}%a" (pp_seq_diff pp_diff pe) fel (pp_inst_if_trace pe) inst | Earray (len, nel, inst) -> let pp_diff f (i, se) = F.fprintf f "%a:%a" (Exp.pp_diff pe) i (pp_sexp_env pe envo) se in diff --git a/infer/src/biabduction/Predicates.mli b/infer/src/biabduction/Predicates.mli index a7efb969d..5520036af 100644 --- a/infer/src/biabduction/Predicates.mli +++ b/infer/src/biabduction/Predicates.mli @@ -9,7 +9,7 @@ open! IStd module F = Format (** Offset for an lvalue. *) -type offset = Off_fld of Typ.Fieldname.t * Typ.t | Off_index of Exp.t +type offset = Off_fld of Fieldname.t * Typ.t | Off_index of Exp.t (** {2 Components of Propositions} *) @@ -96,7 +96,7 @@ val inst_partial_meet : inst -> inst -> inst (** structured expressions represent a value of structured type, such as an array or a struct. *) type 'inst strexp0 = | Eexp of Exp.t * 'inst (** Base case: expression with instrumentation *) - | Estruct of (Typ.Fieldname.t * 'inst strexp0) list * 'inst (** C structure *) + | Estruct of (Fieldname.t * 'inst strexp0) list * 'inst (** C structure *) | Earray of Exp.t * (Exp.t * 'inst strexp0) list * 'inst (** Array of given length There are two conditions imposed / used in the array case. First, if some index and value pair appears inside an array in a strexp, then the index is less than diff --git a/infer/src/biabduction/Prop.ml b/infer/src/biabduction/Prop.ml index 685334503..5cef857d5 100644 --- a/infer/src/biabduction/Prop.ml +++ b/infer/src/biabduction/Prop.ml @@ -440,7 +440,7 @@ let rec pp_path f = function | [] -> () | (name, fld) :: path -> - F.fprintf f "%a.%a: " Typ.Name.pp name Typ.Fieldname.pp fld ; + F.fprintf f "%a.%a: " Typ.Name.pp name Fieldname.pp fld ; pp_path f path @@ -1240,7 +1240,7 @@ module Normalize = struct (* n1-e1 == n2 -> e1==n1-n2 *) (e1, Exp.int (n1 -- n2)) | Lfield (e1', fld1, _), Lfield (e2', fld2, _) -> - if Typ.Fieldname.equal fld1 fld2 then normalize_eq (e1', e2') else eq + if Fieldname.equal fld1 fld2 then normalize_eq (e1', e2') else eq | Lindex (e1', idx1), Lindex (e2', idx2) -> if Exp.equal idx1 idx2 then normalize_eq (e1', e2') else if Exp.equal e1' e2' then normalize_eq (idx1, idx2) @@ -1321,18 +1321,18 @@ module Normalize = struct se | _ :: _ -> let fld_cnts' = - IList.map_changed fld_cnts ~equal:[%compare.equal: Typ.Fieldname.t * Predicates.strexp] + IList.map_changed fld_cnts ~equal:[%compare.equal: Fieldname.t * Predicates.strexp] ~f:(fun ((fld, cnt) as x) -> let cnt' = strexp_normalize tenv sub cnt in if phys_equal cnt cnt' then x else (fld, cnt') ) in if phys_equal fld_cnts fld_cnts' - && List.is_sorted ~compare:[%compare: Typ.Fieldname.t * Predicates.strexp] fld_cnts + && List.is_sorted ~compare:[%compare: Fieldname.t * Predicates.strexp] fld_cnts then se else let fld_cnts'' = - List.sort ~compare:[%compare: Typ.Fieldname.t * Predicates.strexp] fld_cnts' + List.sort ~compare:[%compare: Fieldname.t * Predicates.strexp] fld_cnts' in Estruct (fld_cnts'', inst) ) | Earray (len, idx_cnts, inst) -> ( @@ -2544,7 +2544,7 @@ let rec strexp_gc_fields (se : Predicates.strexp) = let fselo' = List.filter ~f:(function _, Some _ -> true | _ -> false) fselo in List.map ~f:(function f, seo -> (f, unSome seo)) fselo' in - if [%compare.equal: (Typ.Fieldname.t * Predicates.strexp) list] fsel fsel' then Some se + if [%compare.equal: (Fieldname.t * Predicates.strexp) list] fsel fsel' then Some se else Some (Predicates.Estruct (fsel', inst)) | Earray _ -> Some se diff --git a/infer/src/biabduction/Propgraph.ml b/infer/src/biabduction/Propgraph.ml index 6689b12f9..e69bc8481 100644 --- a/infer/src/biabduction/Propgraph.ml +++ b/infer/src/biabduction/Propgraph.ml @@ -124,7 +124,7 @@ let rec compute_sexp_diff (se1 : Predicates.strexp) (se2 : Predicates.strexp) : and compute_fsel_diff fsel1 fsel2 : Obj.t list = match (fsel1, fsel2) with | (f1, se1) :: fsel1', ((f2, se2) as x) :: fsel2' -> ( - match Typ.Fieldname.compare f1 f2 with + match Fieldname.compare f1 f2 with | n when n < 0 -> compute_fsel_diff fsel1' fsel2 | 0 -> diff --git a/infer/src/biabduction/Prover.ml b/infer/src/biabduction/Prover.ml index 826e44919..57416eef5 100644 --- a/infer/src/biabduction/Prover.ml +++ b/infer/src/biabduction/Prover.ml @@ -701,7 +701,7 @@ let check_disequal tenv prop e1 e2 = | Exp.UnOp (op1, e1, _), Exp.UnOp (op2, e2, _) -> if Unop.equal op1 op2 then check_expr_disequal e1 e2 else false | Exp.Lfield (e1, f1, _), Exp.Lfield (e2, f2, _) -> - if Typ.Fieldname.equal f1 f2 then check_expr_disequal e1 e2 else false + if Fieldname.equal f1 f2 then check_expr_disequal e1 e2 else false | Exp.Exn e1, Exp.Exn e2 -> check_expr_disequal e1 e2 | _, _ -> @@ -1396,7 +1396,7 @@ let exp_imply tenv calc_missing (subs : subst2) e1_in e2_in : subst2 = raise (IMPL_EXC ("expressions not equal", subs, EXC_FALSE_EXPS (e1, e2))) | e1, Exp.Const _ -> raise (IMPL_EXC ("lhs not constant", subs, EXC_FALSE_EXPS (e1, e2))) - | Exp.Lfield (e1, fd1, _), Exp.Lfield (e2, fd2, _) when Typ.Fieldname.equal fd1 fd2 -> + | Exp.Lfield (e1, fd1, _), Exp.Lfield (e2, fd2, _) when Fieldname.equal fd1 fd2 -> do_imply subs e1 e2 | Exp.Lindex (e1, f1), Exp.Lindex (e2, f2) -> do_imply (do_imply subs e1 e2) f1 f2 @@ -1418,7 +1418,7 @@ let path_to_id path = if Ident.is_footprint id then None else Some (Ident.name_to_string (Ident.get_name id) ^ string_of_int (Ident.get_stamp id)) | Exp.Lfield (e, fld, _) -> ( - match f e with None -> None | Some s -> Some (s ^ "_" ^ Typ.Fieldname.to_string fld) ) + match f e with None -> None | Some s -> Some (s ^ "_" ^ Fieldname.to_string fld) ) | Exp.Lindex (e, ind) -> ( match f e with None -> None | Some s -> Some (s ^ "_" ^ Exp.to_string ind) ) | Exp.Lvar _ -> @@ -1532,14 +1532,13 @@ let rec sexp_imply tenv source calc_index_frame calc_missing subs se1 se2 typ2 : and struct_imply tenv source calc_missing subs fsel1 fsel2 typ2 : - subst2 * (Typ.Fieldname.t * Predicates.strexp) list * (Typ.Fieldname.t * Predicates.strexp) list - = + subst2 * (Fieldname.t * Predicates.strexp) list * (Fieldname.t * Predicates.strexp) list = let lookup = Tenv.lookup tenv in match (fsel1, fsel2) with | _, [] -> (subs, fsel1, []) | (f1, se1) :: fsel1', (f2, se2) :: fsel2' -> ( - match Typ.Fieldname.compare f1 f2 with + match Fieldname.compare f1 f2 with | 0 -> let typ' = Struct.fld_typ ~lookup ~default:(Typ.mk Tvoid) f2 typ2 in let subs', se_frame, se_missing = @@ -2286,7 +2285,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : subst2 * , Predicates.inst_none ) | Java -> let mk_fld_sexp field_name = - let fld = Typ.Fieldname.make Typ.Name.Java.java_lang_string field_name in + let fld = Fieldname.make Typ.Name.Java.java_lang_string field_name in let se = Predicates.Eexp (Exp.Var (Ident.create_fresh Ident.kprimed), Predicates.Inone) in @@ -2319,7 +2318,7 @@ and sigma_imply tenv calc_index_frame calc_missing subs prop1 sigma2 : subst2 * let sexp = (* TODO: add appropriate fields *) Predicates.Estruct - ( [ ( Typ.Fieldname.make Typ.Name.Java.java_lang_class "name" + ( [ ( Fieldname.make Typ.Name.Java.java_lang_class "name" , Predicates.Eexp (Exp.Const (Const.Cstr s), Predicates.Inone) ) ] , Predicates.inst_none ) in diff --git a/infer/src/biabduction/Rearrange.ml b/infer/src/biabduction/Rearrange.ml index d20a37bd9..f4a760532 100644 --- a/infer/src/biabduction/Rearrange.ml +++ b/infer/src/biabduction/Rearrange.ml @@ -105,14 +105,14 @@ let rec create_struct_values pname tenv orig_prop footprint_part kind max_stamp | Tstruct name, Off_fld (f, _) :: off' -> ( match Tenv.lookup tenv name with | Some ({fields; statics} as struct_typ) -> ( - match List.find ~f:(fun (f', _, _) -> Typ.Fieldname.equal f f') (fields @ statics) with + match List.find ~f:(fun (f', _, _) -> Fieldname.equal f f') (fields @ statics) with | Some (_, t', _) -> let atoms', se', res_t' = create_struct_values pname tenv orig_prop footprint_part kind max_stamp t' off' inst in let se = Predicates.Estruct ([(f, se')], inst) in let replace_typ_of_f (f', t', a') = - if Typ.Fieldname.equal f f' then (f, res_t', a') else (f', t', a') + if Fieldname.equal f f' then (f, res_t', a') else (f', t', a') in let fields' = List.sort ~compare:Struct.compare_field (List.map ~f:replace_typ_of_f fields) @@ -203,9 +203,9 @@ let rec strexp_extend_values_ pname tenv orig_prop footprint_part kind max_stamp | Off_fld (f, _) :: off', Predicates.Estruct (fsel, inst'), Tstruct name -> ( match Tenv.lookup tenv name with | Some ({fields; statics} as struct_typ) -> ( - match List.find ~f:(fun (f', _, _) -> Typ.Fieldname.equal f f') (fields @ statics) with + match List.find ~f:(fun (f', _, _) -> Fieldname.equal f f') (fields @ statics) with | Some (_, typ', _) -> ( - match List.find ~f:(fun (f', _) -> Typ.Fieldname.equal f f') fsel with + match List.find ~f:(fun (f', _) -> Fieldname.equal f f') fsel with | Some (_, se') -> let atoms_se_typ_list' = strexp_extend_values_ pname tenv orig_prop footprint_part kind max_stamp se' typ' off' @@ -213,14 +213,14 @@ let rec strexp_extend_values_ pname tenv orig_prop footprint_part kind max_stamp in let replace acc (res_atoms', res_se', res_typ') = let replace_fse ((f1, _) as ft1) = - if Typ.Fieldname.equal f1 f then (f1, res_se') else ft1 + if Fieldname.equal f1 f then (f1, res_se') else ft1 in let res_fsel' = - List.sort ~compare:[%compare: Typ.Fieldname.t * Predicates.strexp] + List.sort ~compare:[%compare: Fieldname.t * Predicates.strexp] (List.map ~f:replace_fse fsel) in let replace_fta ((f1, _, a1) as fta1) = - if Typ.Fieldname.equal f f1 then (f1, res_typ', a1) else fta1 + if Fieldname.equal f f1 then (f1, res_typ', a1) else fta1 in let fields' = List.sort ~compare:Struct.compare_field (List.map ~f:replace_fta fields) @@ -234,10 +234,10 @@ let rec strexp_extend_values_ pname tenv orig_prop footprint_part kind max_stamp create_struct_values pname tenv orig_prop footprint_part kind max_stamp typ' off' inst in let res_fsel' = - List.sort ~compare:[%compare: Typ.Fieldname.t * Predicates.strexp] ((f, se') :: fsel) + List.sort ~compare:[%compare: Fieldname.t * Predicates.strexp] ((f, se') :: fsel) in let replace_fta (f', t', a') = - if Typ.Fieldname.equal f' f then (f, res_typ', a') else (f', t', a') + if Fieldname.equal f' f then (f, res_typ', a') else (f', t', a') in let fields' = List.sort ~compare:Struct.compare_field (List.map ~f:replace_fta fields) @@ -506,7 +506,7 @@ let prop_iter_check_fields_ptsto_shallow tenv iter lexp = | Predicates.Off_fld (fld, _) :: off' -> ( match se with | Predicates.Estruct (fsel, _) -> ( - match List.find ~f:(fun (fld', _) -> Typ.Fieldname.equal fld fld') fsel with + match List.find ~f:(fun (fld', _) -> Fieldname.equal fld fld') fsel with | Some (_, se') -> check_offset se' off' | None -> @@ -781,7 +781,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = match extract_guarded_by_str item_annot with | Some "this" -> (* expand "this" into .this *) - Some (Printf.sprintf "%s.this" (Typ.Name.name (Typ.Fieldname.get_class_name fld))) + Some (Printf.sprintf "%s.this" (Typ.Name.name (Fieldname.get_class_name fld))) | guarded_by_str_opt -> guarded_by_str_opt ) | _ -> @@ -792,8 +792,8 @@ let add_guarded_by_constraints tenv prop lexp pdesc = let is_guarded_by_fld guarded_by_str fld _ = (* this comparison needs to be somewhat fuzzy, since programmers are free to write @GuardedBy("mLock"), @GuardedBy("MyClass.mLock"), or use other conventions *) - String.equal (Typ.Fieldname.get_field_name fld) guarded_by_str - || String.equal (Typ.Fieldname.to_string fld) guarded_by_str + String.equal (Fieldname.get_field_name fld) guarded_by_str + || String.equal (Fieldname.to_string fld) guarded_by_str in let get_fld_strexp_and_typ typ f flds = let match_one (fld, strexp) = @@ -849,7 +849,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = (* if the guarded-by string is "OuterClass.this", look for "this$n" for some n. note that this is a bit sketchy when there are mutliple this$n's, but there's nothing we can do to disambiguate them. *) - get_fld_strexp_and_typ typ (fun f _ -> Typ.Fieldname.is_java_outer_instance f) flds + get_fld_strexp_and_typ typ (fun f _ -> Fieldname.is_java_outer_instance f) flds | None -> (* can't find an exact match. try a different convention. *) match_on_field_type typ flds @@ -923,7 +923,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = in let guardedby_is_self_referential = String.equal "itself" (String.lowercase guarded_by_str) - || String.is_suffix ~suffix:guarded_by_str (Typ.Fieldname.to_string accessed_fld) + || String.is_suffix ~suffix:guarded_by_str (Fieldname.to_string accessed_fld) in let proc_has_suppress_guarded_by_annot pdesc = match extract_suppress_warnings_str (Annotations.pdesc_get_return_annot pdesc) with @@ -947,7 +947,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = ~f:(fun (fld, strexp) -> match strexp with | Predicates.Eexp (rhs_exp, _) -> - Exp.equal exp rhs_exp && not (Typ.Fieldname.equal fld accessed_fld) + Exp.equal exp rhs_exp && not (Fieldname.equal fld accessed_fld) | _ -> false ) flds @@ -1285,7 +1285,7 @@ let type_at_offset tenv texp off = | Off_fld (f, _) :: off', Tstruct name -> ( match Tenv.lookup tenv name with | Some {fields} -> ( - match List.find ~f:(fun (f', _, _) -> Typ.Fieldname.equal f f') fields with + match List.find ~f:(fun (f', _, _) -> Fieldname.equal f f') fields with | Some (_, typ', _) -> strip_offset off' typ' | None -> @@ -1348,7 +1348,7 @@ let rec iter_rearrange pname tenv lexp typ_from_instr prop iter inst : (* access through field: get the struct type from the field *) if Config.trace_rearrange then ( L.d_increase_indent () ; - L.d_printfln "iter_rearrange: root of lexp accesses field %a" Typ.Fieldname.pp f ; + L.d_printfln "iter_rearrange: root of lexp accesses field %a" Fieldname.pp f ; L.d_str " struct type from field: " ; Typ.d_full fld_typ ; L.d_ln () ; @@ -1491,7 +1491,7 @@ let is_strexp_pt_fld_with_annot tenv obj_str is_annotation typ deref_exp (fld, s match strexp with | Predicates.Eexp ((Exp.Var _ as exp), _) when Exp.equal exp deref_exp -> let has_annot = fld_has_annot fld in - if has_annot then obj_str := Some (Typ.Fieldname.to_simplified_string fld) ; + if has_annot then obj_str := Some (Fieldname.to_simplified_string fld) ; has_annot | _ -> true diff --git a/infer/src/biabduction/RetainCycles.ml b/infer/src/biabduction/RetainCycles.ml index b2129b527..4144fd1ed 100644 --- a/infer/src/biabduction/RetainCycles.ml +++ b/infer/src/biabduction/RetainCycles.ml @@ -45,7 +45,7 @@ let desc_retain_cycle tenv (cycle : RetainCyclesType.t) = match edge with | Object obj -> Format.sprintf "%s --> %s" (from_exp_str obj) - (MF.monospaced_to_string (Typ.Fieldname.to_string obj.rc_field.rc_field_name)) + (MF.monospaced_to_string (Fieldname.to_string obj.rc_field.rc_field_name)) | Block (_, var) -> Format.sprintf "a block that captures %s" (MF.monospaced_to_string (Pvar.to_string var)) in @@ -76,9 +76,7 @@ let edge_is_strong tenv obj_edge = | Tstruct name -> ( match Tenv.lookup tenv name with | Some {fields} -> - List.find - ~f:(fun (fn, _, _) -> Typ.Fieldname.equal obj_edge.rc_field.rc_field_name fn) - fields + List.find ~f:(fun (fn, _, _) -> Fieldname.equal obj_edge.rc_field.rc_field_name fn) fields | None -> None ) | _ -> diff --git a/infer/src/biabduction/RetainCyclesType.ml b/infer/src/biabduction/RetainCyclesType.ml index 0446ba226..62fa0dd57 100644 --- a/infer/src/biabduction/RetainCyclesType.ml +++ b/infer/src/biabduction/RetainCyclesType.ml @@ -8,7 +8,7 @@ open! IStd type retain_cycle_node = {rc_node_exp: Exp.t; rc_node_typ: Typ.t} -type retain_cycle_field = {rc_field_name: Typ.Fieldname.t; rc_field_inst: Predicates.inst} +type retain_cycle_field = {rc_field_name: Fieldname.t; rc_field_inst: Predicates.inst} type retain_cycle_edge_obj = {rc_from: retain_cycle_node; rc_field: retain_cycle_field} @@ -21,7 +21,7 @@ let compare_retain_cycle_node (node1 : retain_cycle_node) (node2 : retain_cycle_ let compare_retain_cycle_field (node1 : retain_cycle_field) (node2 : retain_cycle_field) = - Typ.Fieldname.compare node1.rc_field_name node2.rc_field_name + Fieldname.compare node1.rc_field_name node2.rc_field_name let compare_retain_cycle_edge_obj (obj1 : retain_cycle_edge_obj) (obj2 : retain_cycle_edge_obj) = @@ -66,7 +66,7 @@ let is_inst_rearrange node = let is_isa_field node = match node with | Object obj -> - String.equal (Typ.Fieldname.to_string obj.rc_field.rc_field_name) "isa" + String.equal (Fieldname.to_string obj.rc_field.rc_field_name) "isa" | Block _ -> false @@ -99,8 +99,7 @@ let pp_retain_cycle_node f (node : retain_cycle_node) = let pp_retain_cycle_field f (field : retain_cycle_field) = - Format.fprintf f "%a[%a]" Typ.Fieldname.pp field.rc_field_name Predicates.pp_inst - field.rc_field_inst + Format.fprintf f "%a[%a]" Fieldname.pp field.rc_field_name Predicates.pp_inst field.rc_field_inst let pp_retain_cycle_edge f (edge : retain_cycle_edge) = @@ -172,14 +171,14 @@ let pp_dotty fmt cycle = | Object obj -> Format.fprintf fmt "%s_%a" (Typ.to_string obj.rc_from.rc_node_typ) - Typ.Fieldname.pp obj.rc_field.rc_field_name + Fieldname.pp obj.rc_field.rc_field_name | Block (name, _) -> Typ.Procname.pp_unique_id fmt name in let pp_dotty_field fmt element = match element with | Object obj -> - Typ.Fieldname.pp fmt obj.rc_field.rc_field_name + Fieldname.pp fmt obj.rc_field.rc_field_name | Block _ -> Format.fprintf fmt "" in diff --git a/infer/src/biabduction/RetainCyclesType.mli b/infer/src/biabduction/RetainCyclesType.mli index cbd63c43d..2b46c1060 100644 --- a/infer/src/biabduction/RetainCyclesType.mli +++ b/infer/src/biabduction/RetainCyclesType.mli @@ -9,7 +9,7 @@ open! IStd type retain_cycle_node = {rc_node_exp: Exp.t; rc_node_typ: Typ.t} -type retain_cycle_field = {rc_field_name: Typ.Fieldname.t; rc_field_inst: Predicates.inst} +type retain_cycle_field = {rc_field_name: Fieldname.t; rc_field_inst: Predicates.inst} type retain_cycle_edge_obj = {rc_from: retain_cycle_node; rc_field: retain_cycle_field} diff --git a/infer/src/biabduction/SymExec.ml b/infer/src/biabduction/SymExec.ml index fdd8027df..af63c480e 100644 --- a/infer/src/biabduction/SymExec.ml +++ b/infer/src/biabduction/SymExec.ml @@ -17,7 +17,7 @@ let rec fldlist_assoc fld = function | [] -> raise Caml.Not_found | (fld', x, _) :: l -> - if Typ.Fieldname.equal fld fld' then x else fldlist_assoc fld l + if Fieldname.equal fld fld' then x else fldlist_assoc fld l let unroll_type tenv (typ : Typ.t) (off : Predicates.offset) = @@ -33,9 +33,9 @@ let unroll_type tenv (typ : Typ.t) (off : Predicates.offset) = | Tstruct name, Off_fld (fld, _) -> ( match Tenv.lookup tenv name with | Some {fields; statics} -> ( - try fldlist_assoc fld (fields @ statics) with Caml.Not_found -> fail Typ.Fieldname.pp fld ) + try fldlist_assoc fld (fields @ statics) with Caml.Not_found -> fail Fieldname.pp fld ) | None -> - fail Typ.Fieldname.pp fld ) + fail Fieldname.pp fld ) | Tarray {elt}, Off_index _ -> elt | _, Off_index (Const (Cint i)) when IntLit.iszero i -> @@ -108,18 +108,16 @@ let rec apply_offlist pdesc tenv p fp_root nullify_struct (root_lexp, strexp, ty match Tenv.lookup tenv name with | Some ({fields} as struct_typ) -> ( let t' = unroll_type tenv typ (Predicates.Off_fld (fld, fld_typ)) in - match List.find ~f:(fun fse -> Typ.Fieldname.equal fld (fst fse)) fsel with + match List.find ~f:(fun fse -> Fieldname.equal fld (fst fse)) fsel with | Some (_, se') -> let res_e', res_se', res_t', res_pred_insts_op' = apply_offlist pdesc tenv p fp_root nullify_struct (root_lexp, se', t') offlist' f inst lookup_inst in - let replace_fse fse = - if Typ.Fieldname.equal fld (fst fse) then (fld, res_se') else fse - in + let replace_fse fse = if Fieldname.equal fld (fst fse) then (fld, res_se') else fse in let res_se = Predicates.Estruct (List.map ~f:replace_fse fsel, inst') in let replace_fta (f, t, a) = - if Typ.Fieldname.equal fld f then (fld, res_t', a) else (f, t, a) + if Fieldname.equal fld f then (fld, res_t', a) else (f, t, a) in let fields' = List.map ~f:replace_fta fields in ignore (Tenv.mk_struct tenv ~default:struct_typ ~fields:fields' name) ; @@ -1781,7 +1779,7 @@ and check_variadic_sentinel_if_present ({Builtin.prop_; path; proc_name} as buil and sym_exec_objc_getter field ret_typ tenv ret_id pdesc pname loc args prop = let field_name, _, _ = field in L.d_printfln "No custom getter found. Executing the ObjC builtin getter with ivar %a." - Typ.Fieldname.pp field_name ; + Fieldname.pp field_name ; match args with | [ ( lexp , ( ({Typ.desc= Tstruct struct_name} as typ) @@ -1797,7 +1795,7 @@ and sym_exec_objc_getter field ret_typ tenv ret_id pdesc pname loc args prop = and sym_exec_objc_setter field _ tenv _ pdesc pname loc args prop = let field_name, _, _ = field in L.d_printfln "No custom setter found. Executing the ObjC builtin setter with ivar %a." - Typ.Fieldname.pp field_name ; + Fieldname.pp field_name ; match args with | ( lexp1 , ( ({Typ.desc= Tstruct struct_name} as typ1) diff --git a/infer/src/biabduction/Tabulation.ml b/infer/src/biabduction/Tabulation.ml index c03928ad8..4b622f455 100644 --- a/infer/src/biabduction/Tabulation.ml +++ b/infer/src/biabduction/Tabulation.ml @@ -533,7 +533,7 @@ let rec fsel_star_fld fsel1 fsel2 = | fsel1, [] -> fsel1 | (f1, se1) :: fsel1', (f2, se2) :: fsel2' -> ( - match Typ.Fieldname.compare f1 f2 with + match Fieldname.compare f1 f2 with | 0 -> (f1, sexp_star_fld se1 se2) :: fsel_star_fld fsel1' fsel2' | n when n < 0 -> @@ -593,7 +593,7 @@ let texp_star tenv texp1 texp2 = | _, [] -> false | (f1, _, _) :: ftal1', (f2, _, _) :: ftal2' -> ( - match Typ.Fieldname.compare f1 f2 with + match Fieldname.compare f1 f2 with | n when n < 0 -> false | 0 -> @@ -1088,7 +1088,7 @@ let check_uninitialize_dangling_deref caller_pname tenv callee_pname actual_pre let missing_sigma_need_adding_to_tenv tenv hpreds = let field_is_missing struc (field, _) = - not (List.exists struc.Struct.fields ~f:(fun (fname, _, _) -> Typ.Fieldname.equal fname field)) + not (List.exists struc.Struct.fields ~f:(fun (fname, _, _) -> Fieldname.equal fname field)) in let missing_hpred_need_adding_to_tenv hpred = match hpred with diff --git a/infer/src/bufferoverrun/absLoc.ml b/infer/src/bufferoverrun/absLoc.ml index b8dd89923..5be95437c 100644 --- a/infer/src/bufferoverrun/absLoc.ml +++ b/infer/src/bufferoverrun/absLoc.ml @@ -134,8 +134,8 @@ module Loc = struct type t = | Var of Var.t | Allocsite of Allocsite.t - | Field of {prefix: t; fn: Typ.Fieldname.t; typ: field_typ} - | StarField of {prefix: t; last_field: Typ.Fieldname.t} + | Field of {prefix: t; fn: Fieldname.t; typ: field_typ} + | StarField of {prefix: t; last_field: Fieldname.t} [@@deriving compare] let of_var v = Var v @@ -146,11 +146,11 @@ module Loc = struct let rec aux = function | Var _ | Allocsite _ -> Field {prefix= l0; fn; typ} - | StarField {last_field} as l when Typ.Fieldname.equal fn last_field -> + | StarField {last_field} as l when Fieldname.equal fn last_field -> l | StarField {prefix} -> StarField {prefix; last_field= fn} - | Field {fn= fn'} when Typ.Fieldname.equal fn fn' -> + | Field {fn= fn'} when Fieldname.equal fn fn' -> StarField {prefix= l0; last_field= fn} | Field {prefix= l} -> aux l @@ -162,7 +162,7 @@ module Loc = struct let rec aux = function | Var _ | Allocsite _ -> StarField {prefix= l0; last_field= fn} - | StarField {last_field} as l when Typ.Fieldname.equal fn last_field -> + | StarField {last_field} as l when Fieldname.equal fn last_field -> l | StarField {prefix} -> StarField {prefix; last_field= fn} @@ -175,17 +175,17 @@ module Loc = struct type t = private | Var of Var.t | Allocsite of Allocsite.t - | Field of {prefix: t; fn: Typ.Fieldname.t; typ: field_typ} - | StarField of {prefix: t; last_field: Typ.Fieldname.t} + | Field of {prefix: t; fn: Fieldname.t; typ: field_typ} + | StarField of {prefix: t; last_field: Fieldname.t} [@@deriving compare] val of_var : Var.t -> t val of_allocsite : Allocsite.t -> t - val append_field : ?typ:Typ.t -> t -> fn:Typ.Fieldname.t -> t + val append_field : ?typ:Typ.t -> t -> fn:Fieldname.t -> t - val append_star_field : t -> fn:Typ.Fieldname.t -> t + val append_star_field : t -> fn:Fieldname.t -> t end ) let equal = [%compare.equal: t] @@ -242,14 +242,14 @@ module Loc = struct let is_c_strlen = function | Field {fn} -> - Typ.Fieldname.equal fn (BufferOverrunField.c_strlen ()) + Fieldname.equal fn (BufferOverrunField.c_strlen ()) | _ -> false let is_java_collection_internal_array = function | Field {fn} -> - Typ.Fieldname.equal fn BufferOverrunField.java_collection_internal_array + Fieldname.equal fn BufferOverrunField.java_collection_internal_array | _ -> false @@ -297,7 +297,7 @@ module Loc = struct let get_literal_string = function Allocsite a -> Allocsite.get_literal_string a | _ -> None let get_literal_string_strlen = function - | Field {prefix= l; fn} when Typ.Fieldname.equal (BufferOverrunField.c_strlen ()) fn -> + | Field {prefix= l; fn} when Fieldname.equal (BufferOverrunField.c_strlen ()) fn -> get_literal_string l | _ -> None diff --git a/infer/src/bufferoverrun/absLoc.mli b/infer/src/bufferoverrun/absLoc.mli index 25e8673e8..3c5464d08 100644 --- a/infer/src/bufferoverrun/absLoc.mli +++ b/infer/src/bufferoverrun/absLoc.mli @@ -48,9 +48,9 @@ module Loc : sig type t = private | Var of Var.t (** abstract location of variable *) | Allocsite of Allocsite.t (** abstract location of allocsites *) - | Field of {prefix: t; fn: Typ.Fieldname.t; typ: field_typ} + | Field of {prefix: t; fn: Fieldname.t; typ: field_typ} (** field appended abstract locations, i.e., [prefix.fn] *) - | StarField of {prefix: t; last_field: Typ.Fieldname.t} + | StarField of {prefix: t; last_field: Fieldname.t} (** field appended abstract locations, but some of intermediate fields are abstracted, i.e., [prefix.*.fn] *) [@@deriving equal] @@ -100,16 +100,16 @@ module Loc : sig val represents_multiple_values : t -> bool - val append_field : ?typ:Typ.typ -> t -> fn:Typ.Fieldname.t -> t + val append_field : ?typ:Typ.typ -> t -> fn:Fieldname.t -> t (** It appends field. [typ] is the type of [fn]. *) end module PowLoc : sig include AbstractDomain.FiniteSetS with type elt = Loc.t - val append_field : t -> fn:Typ.Fieldname.t -> t + val append_field : t -> fn:Fieldname.t -> t - val append_star_field : t -> fn:Typ.Fieldname.t -> t + val append_star_field : t -> fn:Fieldname.t -> t val bot : t diff --git a/infer/src/bufferoverrun/bufferOverrunAnalysis.ml b/infer/src/bufferoverrun/bufferOverrunAnalysis.ml index 559d6ce34..88ae67d8b 100644 --- a/infer/src/bufferoverrun/bufferOverrunAnalysis.ml +++ b/infer/src/bufferoverrun/bufferOverrunAnalysis.ml @@ -200,7 +200,7 @@ module TransferFunctions = struct match Typ.Procname.get_class_type_name callee_pname with | Some (JavaClass class_name as typename) -> let class_var = Loc.of_var (Var.of_pvar (Pvar.mk_global class_name)) in - let fn = Typ.Fieldname.make typename "$VALUES" in + let fn = Fieldname.make typename "$VALUES" in let v = Dom.Mem.find (Loc.append_field class_var ~fn) mem in Dom.Mem.add_stack (Loc.of_id id) v mem | _ -> @@ -210,7 +210,7 @@ module TransferFunctions = struct let join_java_static_final = let known_java_static_fields = String.Set.of_list [".EMPTY"] in let is_known_java_static_field fn = - let fieldname = Typ.Fieldname.to_string fn in + let fieldname = Fieldname.to_string fn in String.Set.exists known_java_static_fields ~f:(fun suffix -> String.is_suffix fieldname ~suffix ) in @@ -245,7 +245,7 @@ module TransferFunctions = struct fun exp model_env ret mem -> match exp with | Exp.Lfield (_, fieldname, typ) - when String.Set.mem known_empty_collections (Typ.Fieldname.get_field_name fieldname) + when String.Set.mem known_empty_collections (Fieldname.get_field_name fieldname) && String.equal "java.util.Collections" (Typ.to_string typ) -> Models.Collection.create_collection model_env ~ret mem ~length:Itv.zero |> Option.some | _ -> diff --git a/infer/src/bufferoverrun/bufferOverrunField.ml b/infer/src/bufferoverrun/bufferOverrunField.ml index 0b43f651d..4ad4c03e8 100644 --- a/infer/src/bufferoverrun/bufferOverrunField.ml +++ b/infer/src/bufferoverrun/bufferOverrunField.ml @@ -8,30 +8,30 @@ open! IStd module F = Format module L = Logging -let pp ~pp_lhs ~sep f lhs fn = F.fprintf f "%a%s%s" pp_lhs lhs sep (Typ.Fieldname.get_field_name fn) +let pp ~pp_lhs ~sep f lhs fn = F.fprintf f "%a%s%s" pp_lhs lhs sep (Fieldname.get_field_name fn) let mk, get_type = let class_name = "__infer__" in - let types = ref Typ.Fieldname.Map.empty in + let types = ref Fieldname.Map.empty in let mk ?cpp_classname name typ = let fieldname = match cpp_classname with | None -> let class_name, field_name = String.rsplit2_exn ~on:'.' (class_name ^ "." ^ name) in - Typ.Fieldname.make (Typ.Name.Java.from_string class_name) field_name + Fieldname.make (Typ.Name.Java.from_string class_name) field_name | Some classname -> - Typ.Fieldname.make classname name + Fieldname.make classname name in - types := Typ.Fieldname.Map.add fieldname typ !types ; + types := Fieldname.Map.add fieldname typ !types ; fieldname in - let get_type fn = Typ.Fieldname.Map.find_opt fn !types in + let get_type fn = Fieldname.Map.find_opt fn !types in (mk, get_type) let java_collection_internal_array = mk "java.collection.elements" Typ.(mk_array void) -let is_java_collection_internal_array fn = Typ.Fieldname.equal fn java_collection_internal_array +let is_java_collection_internal_array fn = Fieldname.equal fn java_collection_internal_array let c_strlen () = if Language.curr_language_is Java then mk "length" Typ.uint else mk "c.strlen" Typ.uint @@ -55,4 +55,4 @@ let cpp_vector_elem ~vec_typ ~elt_typ = mk ~cpp_classname:classname cpp_vector_elem_str {Typ.desc; quals= Typ.mk_type_quals ()} -let is_cpp_vector_elem fn = String.equal (Typ.Fieldname.to_simplified_string fn) cpp_vector_elem_str +let is_cpp_vector_elem fn = String.equal (Fieldname.to_simplified_string fn) cpp_vector_elem_str diff --git a/infer/src/bufferoverrun/bufferOverrunField.mli b/infer/src/bufferoverrun/bufferOverrunField.mli index 28f662bd1..fbdcc3c7e 100644 --- a/infer/src/bufferoverrun/bufferOverrunField.mli +++ b/infer/src/bufferoverrun/bufferOverrunField.mli @@ -11,24 +11,24 @@ val pp : -> sep:string -> Format.formatter -> 'a - -> Typ.Fieldname.t + -> Fieldname.t -> unit (** A parameterized pretty printer for field appended values *) -val get_type : Typ.Fieldname.t -> Typ.t option +val get_type : Fieldname.t -> Typ.t option (** Get type of field that is constructed in this module. This does not work in Java at the moment. *) -val c_strlen : unit -> Typ.Fieldname.t +val c_strlen : unit -> Fieldname.t (** Field for C string's length *) -val cpp_vector_elem : vec_typ:Typ.t -> elt_typ:Typ.t -> Typ.Fieldname.t +val cpp_vector_elem : vec_typ:Typ.t -> elt_typ:Typ.t -> Fieldname.t (** Field for C++ vector's elements *) -val java_collection_internal_array : Typ.Fieldname.t +val java_collection_internal_array : Fieldname.t (** Field for Java collection's elements *) -val is_cpp_vector_elem : Typ.Fieldname.t -> bool +val is_cpp_vector_elem : Fieldname.t -> bool (** Check if the field is for C++ vector's elements *) -val is_java_collection_internal_array : Typ.Fieldname.t -> bool +val is_java_collection_internal_array : Fieldname.t -> bool (** Check if the field is for Java collection's elements *) diff --git a/infer/src/bufferoverrun/bufferOverrunModels.ml b/infer/src/bufferoverrun/bufferOverrunModels.ml index 2056b069f..bfbab64ab 100644 --- a/infer/src/bufferoverrun/bufferOverrunModels.ml +++ b/infer/src/bufferoverrun/bufferOverrunModels.ml @@ -467,7 +467,7 @@ module Split = struct let std_vector ~adds_at_least_one {exp= vector_exp; typ= vector_typ} location mem = let increment = if adds_at_least_one then Dom.Val.Itv.pos else Dom.Val.Itv.nat in let vector_type_name = Option.value_exn (vector_typ |> Typ.strip_ptr |> Typ.name) in - let size_field = Typ.Fieldname.make vector_type_name "infer_size" in + let size_field = Fieldname.make vector_type_name "infer_size" in let vector_size_locs = Sem.eval_locs vector_exp mem |> PowLoc.append_field ~fn:size_field in let f_trace _ traces = Trace.(Set.add_elem location (through ~risky_fun:None)) traces in Dom.Mem.transform_mem ~f:(Dom.Val.plus_a ~f_trace increment) vector_size_locs mem diff --git a/infer/src/bufferoverrun/bufferOverrunOndemandEnv.ml b/infer/src/bufferoverrun/bufferOverrunOndemandEnv.ml index ec101a480..856a5f7ce 100644 --- a/infer/src/bufferoverrun/bufferOverrunOndemandEnv.ml +++ b/infer/src/bufferoverrun/bufferOverrunOndemandEnv.ml @@ -67,7 +67,7 @@ let mk pdesc = in let is_last_field fn (fields : Struct.field list) = Option.value_map (List.last fields) ~default:false ~f:(fun (last_fn, _, _) -> - Typ.Fieldname.equal fn last_fn ) + Fieldname.equal fn last_fn ) in let rec may_last_field = function | SPath.Pvar _ | SPath.Deref _ | SPath.Callsite _ -> diff --git a/infer/src/bufferoverrun/bufferOverrunSemantics.ml b/infer/src/bufferoverrun/bufferOverrunSemantics.ml index ed3ccfd29..55547937c 100644 --- a/infer/src/bufferoverrun/bufferOverrunSemantics.ml +++ b/infer/src/bufferoverrun/bufferOverrunSemantics.ml @@ -47,7 +47,7 @@ let rec must_alias : Exp.t -> Exp.t -> Mem.t -> bool = | Exp.Lvar x1, Exp.Lvar x2 -> Pvar.equal x1 x2 | Exp.Lfield (e1, fld1, _), Exp.Lfield (e2, fld2, _) -> - must_alias e1 e2 m && Typ.Fieldname.equal fld1 fld2 + must_alias e1 e2 m && Fieldname.equal fld1 fld2 | Exp.Lindex (e11, e12), Exp.Lindex (e21, e22) -> must_alias e11 e21 m && must_alias e12 e22 m | Exp.Sizeof {nbytes= Some nbytes1}, Exp.Sizeof {nbytes= Some nbytes2} -> diff --git a/infer/src/bufferoverrun/symb.ml b/infer/src/bufferoverrun/symb.ml index 285673d98..278c0ffd1 100644 --- a/infer/src/bufferoverrun/symb.ml +++ b/infer/src/bufferoverrun/symb.ml @@ -32,9 +32,9 @@ module SymbolPath = struct type partial = | Pvar of Pvar.t | Deref of deref_kind * partial - | Field of {fn: Typ.Fieldname.t; prefix: partial; typ: field_typ} + | Field of {fn: Fieldname.t; prefix: partial; typ: field_typ} | Callsite of {ret_typ: Typ.t; cs: CallSite.t} - | StarField of {last_field: Typ.Fieldname.t; prefix: partial} + | StarField of {last_field: Fieldname.t; prefix: partial} [@@deriving compare] let of_pvar pvar = Pvar pvar @@ -49,7 +49,7 @@ module SymbolPath = struct StarField {last_field= fn; prefix= p0} | Deref (_, p) | Field {prefix= p} -> aux p - | StarField {last_field} as p when Typ.Fieldname.equal fn last_field -> + | StarField {last_field} as p when Fieldname.equal fn last_field -> p | StarField {prefix} -> StarField {last_field= fn; prefix} @@ -61,11 +61,11 @@ module SymbolPath = struct let rec aux = function | Pvar _ | Callsite _ -> Field {fn; prefix= p0; typ} - | Field {fn= fn'} when Typ.Fieldname.equal fn fn' -> + | Field {fn= fn'} when Fieldname.equal fn fn' -> StarField {last_field= fn; prefix= p0} | Field {prefix= p} | Deref (_, p) -> aux p - | StarField {last_field} as p when Typ.Fieldname.equal fn last_field -> + | StarField {last_field} as p when Fieldname.equal fn last_field -> p | StarField {prefix} -> StarField {last_field= fn; prefix} @@ -76,9 +76,9 @@ module SymbolPath = struct type partial = private | Pvar of Pvar.t | Deref of deref_kind * partial - | Field of {fn: Typ.Fieldname.t; prefix: partial; typ: field_typ} + | Field of {fn: Fieldname.t; prefix: partial; typ: field_typ} | Callsite of {ret_typ: Typ.t; cs: CallSite.t} - | StarField of {last_field: Typ.Fieldname.t; prefix: partial} + | StarField of {last_field: Fieldname.t; prefix: partial} [@@deriving compare] val of_pvar : Pvar.t -> partial @@ -87,9 +87,9 @@ module SymbolPath = struct val deref : deref_kind:deref_kind -> partial -> partial - val field : ?typ:Typ.t -> partial -> Typ.Fieldname.t -> partial + val field : ?typ:Typ.t -> partial -> Fieldname.t -> partial - val star_field : partial -> Typ.Fieldname.t -> partial + val star_field : partial -> Fieldname.t -> partial end ) type t = @@ -220,7 +220,7 @@ module SymbolPath = struct | Deref (_, x) -> exists_str_partial ~f x | Field {fn= fld; prefix= x} | StarField {last_field= fld; prefix= x} -> - f (Typ.Fieldname.to_string fld) || exists_str_partial ~f x + f (Fieldname.to_string fld) || exists_str_partial ~f x | Callsite _ -> false diff --git a/infer/src/bufferoverrun/symb.mli b/infer/src/bufferoverrun/symb.mli index 9903ada4f..8c890bc4b 100644 --- a/infer/src/bufferoverrun/symb.mli +++ b/infer/src/bufferoverrun/symb.mli @@ -21,9 +21,9 @@ module SymbolPath : sig type partial = private | Pvar of Pvar.t | Deref of deref_kind * partial - | Field of {fn: Typ.Fieldname.t; prefix: partial; typ: Typ.t option} + | Field of {fn: Fieldname.t; prefix: partial; typ: Typ.t option} | Callsite of {ret_typ: Typ.t; cs: CallSite.t} - | StarField of {last_field: Typ.Fieldname.t; prefix: partial} + | StarField of {last_field: Fieldname.t; prefix: partial} (** Represents a path starting with [prefix] and ending with the field [last_field], the middle can be anything. Invariants: @@ -52,9 +52,9 @@ module SymbolPath : sig val deref : deref_kind:deref_kind -> partial -> partial - val field : ?typ:Typ.t -> partial -> Typ.Fieldname.t -> partial + val field : ?typ:Typ.t -> partial -> Fieldname.t -> partial - val star_field : partial -> Typ.Fieldname.t -> partial + val star_field : partial -> Fieldname.t -> partial val normal : partial -> t diff --git a/infer/src/checkers/NullabilityPreanalysis.ml b/infer/src/checkers/NullabilityPreanalysis.ml index 0b5c1c8ba..9c7231e2d 100644 --- a/infer/src/checkers/NullabilityPreanalysis.ml +++ b/infer/src/checkers/NullabilityPreanalysis.ml @@ -10,10 +10,10 @@ open! IStd module F = Format module FieldsAssignedInConstructors = AbstractDomain.FiniteSet (struct - type t = Typ.Fieldname.t * Typ.t [@@deriving compare] + type t = Fieldname.t * Typ.t [@@deriving compare] let pp fmt (fieldname, typ) = - F.fprintf fmt "(%a, %a)" Typ.Fieldname.pp fieldname (Typ.pp_full Pp.text) typ + F.fprintf fmt "(%a, %a)" Fieldname.pp fieldname (Typ.pp_full Pp.text) typ end) module TransferFunctions (CFG : ProcCfg.S) = struct @@ -67,7 +67,7 @@ module FieldsAssignedInConstructorsChecker = let add_annot annot annot_name = ({Annot.class_name= annot_name; parameters= []}, true) :: annot let add_nonnull_to_selected_field given_field ((fieldname, typ, annot) as field) = - if Typ.Fieldname.equal fieldname given_field && not (Annotations.ia_is_nullable annot) then + if Fieldname.equal fieldname given_field && not (Annotations.ia_is_nullable annot) then let new_annot = add_annot annot Annotations.nonnull in (fieldname, typ, new_annot) else field diff --git a/infer/src/checkers/RequiredProps.ml b/infer/src/checkers/RequiredProps.ml index 4d4f6ba28..d2210e4e1 100644 --- a/infer/src/checkers/RequiredProps.ml +++ b/infer/src/checkers/RequiredProps.ml @@ -53,7 +53,7 @@ let get_required_props typename tenv = List.filter_map ~f:(fun (fieldname, _, annot) -> if is_required annot then - let prop = Typ.Fieldname.get_field_name fieldname in + let prop = Fieldname.get_field_name fieldname in let var_prop_opt = get_var_args annot in Some (Option.value_map var_prop_opt ~default:(Prop prop) ~f:(fun var_prop -> diff --git a/infer/src/checkers/annotations.ml b/infer/src/checkers/annotations.ml index 4f55187e6..ee6ec80ef 100644 --- a/infer/src/checkers/annotations.ml +++ b/infer/src/checkers/annotations.ml @@ -163,9 +163,7 @@ let pname_has_return_annot pname ~attrs_of_pname predicate = let field_has_annot fieldname (struct_typ : Struct.t) predicate = - let fld_has_taint_annot (fname, _, annot) = - Typ.Fieldname.equal fieldname fname && predicate annot - in + let fld_has_taint_annot (fname, _, annot) = Fieldname.equal fieldname fname && predicate annot in List.exists ~f:fld_has_taint_annot struct_typ.fields || List.exists ~f:fld_has_taint_annot struct_typ.statics diff --git a/infer/src/checkers/annotations.mli b/infer/src/checkers/annotations.mli index 69ca97175..93769288a 100644 --- a/infer/src/checkers/annotations.mli +++ b/infer/src/checkers/annotations.mli @@ -132,7 +132,7 @@ val pdesc_return_annot_ends_with : Procdesc.t -> string -> bool val ma_has_annotation_with : Annot.Method.t -> (Annot.t -> bool) -> bool -val field_has_annot : Typ.Fieldname.t -> Struct.t -> (Annot.Item.t -> bool) -> bool +val field_has_annot : Fieldname.t -> Struct.t -> (Annot.Item.t -> bool) -> bool val struct_typ_has_annot : Struct.t -> (Annot.Item.t -> bool) -> bool (** return true if the given predicate evaluates to true on some annotation of [struct_typ] *) diff --git a/infer/src/checkers/fragmentRetainsViewChecker.ml b/infer/src/checkers/fragmentRetainsViewChecker.ml index f5a61705a..5f41dc878 100644 --- a/infer/src/checkers/fragmentRetainsViewChecker.ml +++ b/infer/src/checkers/fragmentRetainsViewChecker.ml @@ -40,9 +40,8 @@ let report_warning class_name fld fld_typ summary = "Fragment %a does not nullify View field %a (type %a) in %a. If this Fragment is placed on \ the back stack, a reference to this (probably dead) View will be retained. In general, it \ is a good idea to initialize View's in %a, then nullify them in %a." - pp_m (Typ.Name.name class_name) pp_m - (Typ.Fieldname.get_field_name fld) - pp_m (format_typ fld_typ) pp_m (format_method pname) pp_m on_create_view pp_m on_destroy_view + pp_m (Typ.Name.name class_name) pp_m (Fieldname.get_field_name fld) pp_m (format_typ fld_typ) + pp_m (format_method pname) pp_m on_create_view pp_m on_destroy_view in Reporting.log_warning summary ~loc IssueType.checkers_fragment_retain_view description @@ -61,7 +60,7 @@ let callback_fragment_retains_view_java java_pname {Callbacks.summary; exe_env} in (* is [fldname] a View type declared by [class_typename]? *) let is_declared_view_typ class_typename (fldname, fld_typ, _) = - let fld_classname = Typ.Fieldname.get_class_name fldname in + let fld_classname = Fieldname.get_class_name fldname in Typ.Name.equal fld_classname class_typename && fld_typ_is_view fld_typ in if is_on_destroy_view then @@ -76,7 +75,7 @@ let callback_fragment_retains_view_java java_pname {Callbacks.summary; exe_env} if not ( Annotations.ia_ends_with ia Annotations.auto_cleanup - || Typ.Fieldname.Set.mem fname fields_nullified ) + || Fieldname.Set.mem fname fields_nullified ) then report_warning class_name fname fld_typ summary ) declared_view_fields | _ -> diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index cd61ffc6d..b6cd4f2eb 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -11,7 +11,7 @@ open! IStd module L = Logging -type field_type = Typ.Fieldname.t * Typ.t * (Annot.t * bool) list +type field_type = Fieldname.t * Typ.t * (Annot.t * bool) list let rec get_fields_super_classes tenv super_class = L.(debug Capture Verbose) @@ -123,7 +123,7 @@ let modelled_field class_name_info = let modelled_field_in_class res (class_name, field_name, typ) = if String.equal class_name class_name_info.Clang_ast_t.ni_name then let class_tname = Typ.Name.Objc.from_string class_name in - let name = Typ.Fieldname.make class_tname field_name in + let name = Fieldname.make class_tname field_name in (name, typ, Annot.Item.empty) :: res else res in diff --git a/infer/src/clang/cField_decl.mli b/infer/src/clang/cField_decl.mli index 1c19c842e..ce2e6a047 100644 --- a/infer/src/clang/cField_decl.mli +++ b/infer/src/clang/cField_decl.mli @@ -9,7 +9,7 @@ open! IStd (** Utility module to retrieve fields of structs of classes *) -type field_type = Typ.Fieldname.t * Typ.t * (Annot.t * bool) list +type field_type = Fieldname.t * Typ.t * (Annot.t * bool) list val get_fields : CAst_utils.qual_type_to_sil_type diff --git a/infer/src/clang/cGeneral_utils.ml b/infer/src/clang/cGeneral_utils.ml index 5ea6c8fc7..411114fce 100644 --- a/infer/src/clang/cGeneral_utils.ml +++ b/infer/src/clang/cGeneral_utils.ml @@ -38,7 +38,7 @@ let add_no_duplicates_fields field_tuple l = match (field_tuple, l) with | (field, typ, annot), ((old_field, old_typ, old_annot) as old_field_tuple) :: rest -> let ret_list, ret_found = replace_field field_tuple rest found in - if Typ.Fieldname.equal field old_field && Typ.equal typ old_typ then + if Fieldname.equal field old_field && Typ.equal typ old_typ then let annotations = append_no_duplicates_annotations annot old_annot in ((field, typ, annotations) :: ret_list, true) else (old_field_tuple :: ret_list, ret_found) @@ -63,7 +63,7 @@ let list_range i j = aux j [] -let mk_class_field_name class_tname field_name = Typ.Fieldname.make class_tname field_name +let mk_class_field_name class_tname field_name = Fieldname.make class_tname field_name let is_cpp_translation translation_unit_context = let lang = translation_unit_context.CFrontend_config.lang in diff --git a/infer/src/clang/cGeneral_utils.mli b/infer/src/clang/cGeneral_utils.mli index 0720c0b43..a83fcf04d 100644 --- a/infer/src/clang/cGeneral_utils.mli +++ b/infer/src/clang/cGeneral_utils.mli @@ -21,7 +21,7 @@ val swap_elements_list : 'a list -> 'a list val list_range : int -> int -> int list -val mk_class_field_name : Typ.Name.t -> string -> Typ.Fieldname.t +val mk_class_field_name : Typ.Name.t -> string -> Fieldname.t val get_var_name_mangled : Clang_ast_t.decl_info diff --git a/infer/src/clang/cMethod_trans.ml b/infer/src/clang/cMethod_trans.ml index 72c020be6..e8b66f6b9 100644 --- a/infer/src/clang/cMethod_trans.ml +++ b/infer/src/clang/cMethod_trans.ml @@ -164,7 +164,7 @@ let get_objc_property_accessor tenv ms = match Tenv.lookup tenv class_tname with | Some {fields} -> ( let field_opt = - List.find ~f:(fun (name, _, _) -> Typ.Fieldname.equal name field_name) fields + List.find ~f:(fun (name, _, _) -> Fieldname.equal name field_name) fields in match field_opt with | Some field when CMethodSignature.is_getter ms -> diff --git a/infer/src/concurrency/RacerD.ml b/infer/src/concurrency/RacerD.ml index c16bc6699..2a03a31da 100644 --- a/infer/src/concurrency/RacerD.ml +++ b/infer/src/concurrency/RacerD.ml @@ -781,7 +781,7 @@ let empty_reported = let should_filter_access exp_opt = let check_access = function | HilExp.Access.FieldAccess fld -> - String.is_substring ~substring:"$SwitchMap" (Typ.Fieldname.to_string fld) + String.is_substring ~substring:"$SwitchMap" (Fieldname.to_string fld) | _ -> false in @@ -884,7 +884,7 @@ let should_report_guardedby_violation classname_str ({snapshot; tenv; procname} false in let field_is_annotated_guardedby field_name (f, _, a) = - Typ.Fieldname.equal f field_name + Fieldname.equal f field_name && List.exists a ~f:(fun ((annot : Annot.t), _) -> Annotations.annot_ends_with annot Annotations.guarded_by && match annot.parameters with [param] -> not (is_uitthread param.value) | _ -> false ) diff --git a/infer/src/concurrency/RacerDModels.ml b/infer/src/concurrency/RacerDModels.ml index 790c5170c..785ce14fd 100644 --- a/infer/src/concurrency/RacerDModels.ml +++ b/infer/src/concurrency/RacerDModels.ml @@ -455,7 +455,7 @@ let is_synchronized_container callee_pname (access_exp : HilExp.AccessExpression with | Access.FieldAccess base_field :: Access.FieldAccess container_field :: _ when Typ.Procname.is_java callee_pname -> - let base_typename = Typ.Fieldname.get_class_name base_field in + let base_typename = Fieldname.get_class_name base_field in is_annotated_synchronized base_typename container_field tenv | [Access.FieldAccess container_field] -> ( match (AccessExpression.get_base access_exp |> snd).desc with diff --git a/infer/src/concurrency/StarvationModels.ml b/infer/src/concurrency/StarvationModels.ml index 576110cc7..674c15618 100644 --- a/infer/src/concurrency/StarvationModels.ml +++ b/infer/src/concurrency/StarvationModels.ml @@ -41,8 +41,8 @@ let secs_of_timeunit = let str_of_access_path = function | _, [AccessPath.FieldAccess field] when String.equal "java.util.concurrent.TimeUnit" - (Typ.Name.name (Typ.Fieldname.get_class_name field)) -> - Some (Typ.Fieldname.get_field_name field) + (Typ.Name.name (Fieldname.get_class_name field)) -> + Some (Fieldname.get_field_name field) | _ -> None in @@ -279,11 +279,11 @@ type scheduler_thread_constraint = ForUIThread | ForNonUIThread | ForUnknownThre annotation constraint, if any. *) let rec get_executor_thread_annotation_constraint tenv (receiver : HilExp.AccessExpression.t) = match receiver with - | FieldOffset (_, field_name) when Typ.Fieldname.is_java field_name -> - Typ.Fieldname.get_class_name field_name + | FieldOffset (_, field_name) when Fieldname.is_java field_name -> + Fieldname.get_class_name field_name |> Tenv.lookup tenv |> Option.map ~f:(fun (tstruct : Struct.t) -> tstruct.fields @ tstruct.statics) - |> Option.bind ~f:(List.find ~f:(fun (fld, _, _) -> Typ.Fieldname.equal fld field_name)) + |> Option.bind ~f:(List.find ~f:(fun (fld, _, _) -> Fieldname.equal fld field_name)) |> Option.bind ~f:(fun (_, _, annot) -> if Annotations.(ia_ends_with annot for_ui_thread) then Some ForUIThread else if Annotations.(ia_ends_with annot for_non_ui_thread) then Some ForNonUIThread diff --git a/infer/src/java/jTrans.ml b/infer/src/java/jTrans.ml index f4b1f603c..337ee32af 100644 --- a/infer/src/java/jTrans.ml +++ b/infer/src/java/jTrans.ml @@ -72,7 +72,7 @@ let get_exit_location source_file bytecode = let retrieve_fieldname fieldname = - let subs = Str.split (Str.regexp (Str.quote ".")) (Typ.Fieldname.to_string fieldname) in + let subs = Str.split (Str.regexp (Str.quote ".")) (Fieldname.to_string fieldname) in List.last_exn subs diff --git a/infer/src/java/jTransType.ml b/infer/src/java/jTransType.ml index e566f7cf7..28a571819 100644 --- a/infer/src/java/jTransType.ml +++ b/infer/src/java/jTransType.ml @@ -203,7 +203,7 @@ let get_method_kind m = let create_fieldname cn fs = let field_name = JBasics.fs_name fs in let class_name = JBasics.cn_name cn in - Typ.Fieldname.make (Typ.Name.Java.from_string class_name) field_name + Fieldname.make (Typ.Name.Java.from_string class_name) field_name let create_sil_class_field cn {Javalib.cf_signature; cf_annotations; cf_kind} = @@ -243,15 +243,15 @@ let collect_models_class_fields classpath_field_map cn cf fields = let static, nonstatic = fields in let field_name, field_type, annotation = create_sil_class_field cn cf in try - let classpath_ft = Typ.Fieldname.Map.find field_name classpath_field_map in + let classpath_ft = Fieldname.Map.find field_name classpath_field_map in if Typ.equal classpath_ft field_type then fields else (* TODO (#6711750): fix type equality for arrays before failing here *) let () = L.(debug Capture Quiet) "Found inconsistent types for %s@\n\tclasspath: %a@\n\tmodels: %a@\n@." - (Typ.Fieldname.to_string field_name) - (Typ.pp_full Pp.text) classpath_ft (Typ.pp_full Pp.text) field_type + (Fieldname.to_string field_name) (Typ.pp_full Pp.text) classpath_ft (Typ.pp_full Pp.text) + field_type in fields with Caml.Not_found -> @@ -264,9 +264,9 @@ let add_model_fields program classpath_fields cn = let statics, nonstatics = classpath_fields in let classpath_field_map = let collect_fields map = - List.fold ~f:(fun map (fn, ft, _) -> Typ.Fieldname.Map.add fn ft map) ~init:map + List.fold ~f:(fun map (fn, ft, _) -> Fieldname.Map.add fn ft map) ~init:map in - collect_fields (collect_fields Typ.Fieldname.Map.empty statics) nonstatics + collect_fields (collect_fields Fieldname.Map.empty statics) nonstatics in try match JBasics.ClassMap.find cn (JClasspath.get_models program) with @@ -396,7 +396,7 @@ let get_class_type program tenv cn = (** return true if [field_name] is the autogenerated C.$assertionsDisabled field for class C *) let is_autogenerated_assert_field field_name = - String.equal (Typ.Fieldname.get_field_name field_name) "$assertionsDisabled" + String.equal (Fieldname.get_field_name field_name) "$assertionsDisabled" (** translate an object type *) diff --git a/infer/src/java/jTransType.mli b/infer/src/java/jTransType.mli index 8d04a2cde..f9727d0a4 100644 --- a/infer/src/java/jTransType.mli +++ b/infer/src/java/jTransType.mli @@ -10,7 +10,7 @@ open! IStd open Javalib_pack open Sawja_pack -val create_fieldname : JBasics.class_name -> JBasics.field_signature -> Typ.Fieldname.t +val create_fieldname : JBasics.class_name -> JBasics.field_signature -> Fieldname.t (** translate the name of the field *) val get_method_kind : JCode.jcode Javalib.jmethod -> Typ.Procname.Java.kind @@ -38,7 +38,7 @@ val get_class_type_no_pointer : JClasspath.program -> Tenv.t -> JBasics.class_na val get_class_type : JClasspath.program -> Tenv.t -> JBasics.class_name -> Typ.t (** [get_class_type program tenv cn] returns the sil type representation of the class *) -val is_autogenerated_assert_field : Typ.Fieldname.t -> bool +val is_autogenerated_assert_field : Fieldname.t -> bool (** return true if [field_name] is the autogenerated C.$assertionsDisabled field for class C *) val sizeof_of_object_type : diff --git a/infer/src/nullsafe/AnnotatedField.mli b/infer/src/nullsafe/AnnotatedField.mli index 5c3d0113d..3dbd768aa 100644 --- a/infer/src/nullsafe/AnnotatedField.mli +++ b/infer/src/nullsafe/AnnotatedField.mli @@ -11,5 +11,5 @@ open! IStd type t = {annotation_deprecated: Annot.Item.t; annotated_type: AnnotatedType.t} -val get : Tenv.t -> Typ.Fieldname.t -> Typ.t -> t option +val get : Tenv.t -> Fieldname.t -> Typ.t -> t option (** Looks up for a field declaration and, in case of success, converts it to [t] *) diff --git a/infer/src/nullsafe/AssignmentRule.ml b/infer/src/nullsafe/AssignmentRule.ml index ca0fb2a6f..2d1afd404 100644 --- a/infer/src/nullsafe/AssignmentRule.ml +++ b/infer/src/nullsafe/AssignmentRule.ml @@ -10,7 +10,7 @@ type violation = {is_strict_mode: bool; lhs: Nullability.t; rhs: Nullability.t} type assignment_type = | PassingParamToFunction of function_info - | AssigningToField of Typ.Fieldname.t + | AssigningToField of Fieldname.t | ReturningFromFunction of Typ.Procname.t [@@deriving compare] @@ -175,7 +175,7 @@ let violation_description {is_strict_mode; lhs; rhs} ~assignment_location assign Logging.die InternalError "Invariant violation: unexpected nullability" in Format.asprintf "%a is declared non-nullable but is assigned %s%s." MF.pp_monospaced - (Typ.Fieldname.get_field_name field_name) + (Fieldname.get_field_name field_name) rhs_description nullability_evidence_as_suffix | ReturningFromFunction function_proc_name -> let return_description = diff --git a/infer/src/nullsafe/AssignmentRule.mli b/infer/src/nullsafe/AssignmentRule.mli index 02b2eabd6..10ebf302f 100644 --- a/infer/src/nullsafe/AssignmentRule.mli +++ b/infer/src/nullsafe/AssignmentRule.mli @@ -17,7 +17,7 @@ val check : type assignment_type = | PassingParamToFunction of function_info - | AssigningToField of Typ.Fieldname.t + | AssigningToField of Fieldname.t | ReturningFromFunction of Typ.Procname.t [@@deriving compare] diff --git a/infer/src/nullsafe/DereferenceRule.ml b/infer/src/nullsafe/DereferenceRule.ml index a3d48b37d..732781de5 100644 --- a/infer/src/nullsafe/DereferenceRule.ml +++ b/infer/src/nullsafe/DereferenceRule.ml @@ -10,7 +10,7 @@ type violation = Nullability.t [@@deriving compare] type dereference_type = | MethodCall of Typ.Procname.t - | AccessToField of Typ.Fieldname.t + | AccessToField of Fieldname.t | AccessByIndex of {index_desc: string} | ArrayLengthAccess [@@deriving compare] @@ -70,7 +70,7 @@ let violation_description nullability ~dereference_location dereference_type ~nu (MF.monospaced_to_string (Typ.Procname.to_simplified_string method_name)) | AccessToField field_name -> Format.sprintf "accessing field %s" - (MF.monospaced_to_string (Typ.Fieldname.to_simplified_string field_name)) + (MF.monospaced_to_string (Fieldname.to_simplified_string field_name)) | AccessByIndex {index_desc} -> Format.sprintf "accessing at index %s" (MF.monospaced_to_string index_desc) | ArrayLengthAccess -> diff --git a/infer/src/nullsafe/DereferenceRule.mli b/infer/src/nullsafe/DereferenceRule.mli index 6b9410592..bab4e4919 100644 --- a/infer/src/nullsafe/DereferenceRule.mli +++ b/infer/src/nullsafe/DereferenceRule.mli @@ -15,7 +15,7 @@ val check : is_strict_mode:bool -> Nullability.t -> (unit, violation) result type dereference_type = | MethodCall of Typ.Procname.t - | AccessToField of Typ.Fieldname.t + | AccessToField of Fieldname.t | AccessByIndex of {index_desc: string} | ArrayLengthAccess [@@deriving compare] diff --git a/infer/src/nullsafe/ErrorRenderingUtils.ml b/infer/src/nullsafe/ErrorRenderingUtils.ml index 4d8ff4d5f..de3b15b8f 100644 --- a/infer/src/nullsafe/ErrorRenderingUtils.ml +++ b/infer/src/nullsafe/ErrorRenderingUtils.ml @@ -31,7 +31,7 @@ let is_object_nullability_self_explanatory ~object_expression object_origin = | TypeOrigin.Field {field_name} -> (* Either local variable or expression like `.field_name`. Latter case is trivial: the user can quickly go to field_name definition and see if its annotation. *) - let field_name_str = Typ.Fieldname.get_field_name field_name in + let field_name_str = Fieldname.get_field_name field_name in String.is_suffix object_expression ~suffix:field_name_str | TypeOrigin.MethodCall {pname; annotated_signature= {model_source}} -> let is_modelled = Option.is_some model_source in @@ -75,7 +75,7 @@ let get_method_class_name procname = let get_field_class_name field_name = - let class_with_field = Typ.Fieldname.to_simplified_string field_name in + let class_with_field = Fieldname.to_simplified_string field_name in String.rsplit2 class_with_field ~on:'.' |> Option.value_map ~f:(fun (classname, _) -> classname) ~default:"the field class" @@ -122,7 +122,7 @@ let get_info object_origin = | TypeOrigin.Field {field_name; access_loc} -> let offending_object = Format.asprintf "%a" MarkupFormatter.pp_monospaced - (Typ.Fieldname.to_simplified_string field_name) + (Fieldname.to_simplified_string field_name) in let object_loc = access_loc in (* TODO: currently we do not support third-party annotations for fields. Because of this, diff --git a/infer/src/nullsafe/NullabilitySuggest.ml b/infer/src/nullsafe/NullabilitySuggest.ml index 276f6a5eb..c58f42a2a 100644 --- a/infer/src/nullsafe/NullabilitySuggest.ml +++ b/infer/src/nullsafe/NullabilitySuggest.ml @@ -125,7 +125,7 @@ let make_error_trace astate ap ud = let name_of ap = match AccessPath.get_last_access ap with | Some (AccessPath.FieldAccess field_name) -> - "Field " ^ Typ.Fieldname.get_field_name field_name + "Field " ^ Fieldname.get_field_name field_name | Some (AccessPath.ArrayAccess _) -> "Some array element" | None -> @@ -162,19 +162,19 @@ let pretty_field_name proc_data field_name = match Summary.get_proc_name proc_data.ProcData.summary with | Typ.Procname.Java jproc_name -> let proc_class_name = Typ.Procname.Java.get_class_name jproc_name in - let field_class_name = Typ.Fieldname.get_class_name field_name |> Typ.Name.name in - if String.equal proc_class_name field_class_name then Typ.Fieldname.get_field_name field_name - else Typ.Fieldname.to_simplified_string field_name + let field_class_name = Fieldname.get_class_name field_name |> Typ.Name.name in + if String.equal proc_class_name field_class_name then Fieldname.get_field_name field_name + else Fieldname.to_simplified_string field_name | _ -> (* This format is subject to change once this checker gets to run on C/Cpp/ObjC *) - Typ.Fieldname.to_string field_name + Fieldname.to_string field_name (* Checks if a field name stems from a class outside the domain of what is analyzed by Infer *) let is_outside_codebase proc_name field_name = match proc_name with | Typ.Procname.Java _ -> - Typ.Name.Java.is_external_classname (Typ.Name.name (Typ.Fieldname.get_class_name field_name)) + Typ.Name.Java.is_external_classname (Typ.Name.name (Fieldname.get_class_name field_name)) | _ -> false @@ -199,7 +199,7 @@ let checker {Callbacks.summary; exe_env} = do, so let's do it in ad hoc way. *) () - | Some (field_name, _) when Typ.Fieldname.is_java_captured_parameter field_name -> + | Some (field_name, _) when Fieldname.is_java_captured_parameter field_name -> (* Skip reporting when field comes from generated code *) () | Some (field_name, _) -> diff --git a/infer/src/nullsafe/OverAnnotatedRule.ml b/infer/src/nullsafe/OverAnnotatedRule.ml index 2fb1c0c6e..de03ceda2 100644 --- a/infer/src/nullsafe/OverAnnotatedRule.ml +++ b/infer/src/nullsafe/OverAnnotatedRule.ml @@ -25,7 +25,7 @@ let check ~what ~by_rhs_upper_bound = type violation_type = - | FieldOverAnnoted of Typ.Fieldname.t + | FieldOverAnnoted of Fieldname.t | ReturnOverAnnotated of Typ.Procname.t (** Return value of a method can be made non-nullable *) [@@deriving compare] @@ -36,7 +36,7 @@ let violation_description _ violation_type = | FieldOverAnnoted field_name -> Format.asprintf "Field %a is always initialized in the constructor but is declared %a" MF.pp_monospaced - (Typ.Fieldname.to_simplified_string field_name) + (Fieldname.to_simplified_string field_name) MF.pp_monospaced nullable_annotation | ReturnOverAnnotated proc_name -> Format.asprintf "Method %a is annotated with %a but never returns null." MF.pp_monospaced diff --git a/infer/src/nullsafe/OverAnnotatedRule.mli b/infer/src/nullsafe/OverAnnotatedRule.mli index 375536e42..a8833b644 100644 --- a/infer/src/nullsafe/OverAnnotatedRule.mli +++ b/infer/src/nullsafe/OverAnnotatedRule.mli @@ -25,7 +25,7 @@ val check : what:Nullability.t -> by_rhs_upper_bound:Nullability.t -> (unit, vio bound. *) type violation_type = - | FieldOverAnnoted of Typ.Fieldname.t + | FieldOverAnnoted of Fieldname.t | ReturnOverAnnotated of Typ.Procname.t (** Return value of a method can be made non-nullable *) [@@deriving compare] diff --git a/infer/src/nullsafe/eradicateCheckers.mli b/infer/src/nullsafe/eradicateCheckers.mli index d0cdfa138..09d25f146 100644 --- a/infer/src/nullsafe/eradicateCheckers.mli +++ b/infer/src/nullsafe/eradicateCheckers.mli @@ -15,7 +15,7 @@ val report_error : -> Procdesc.t -> IssueType.t -> Location.t - -> ?field_name:Typ.Fieldname.t option + -> ?field_name:Fieldname.t option -> ?exception_kind:(IssueType.t -> Localise.error_desc -> exn) -> ?severity:Exceptions.severity -> string diff --git a/infer/src/nullsafe/eradicateChecks.ml b/infer/src/nullsafe/eradicateChecks.ml index 4ee4bba67..56c33ac2d 100644 --- a/infer/src/nullsafe/eradicateChecks.ml +++ b/infer/src/nullsafe/eradicateChecks.ml @@ -158,7 +158,7 @@ let check_field_assignment ~is_strict_mode tenv find_canonical_duplicate curr_pd let should_report = (not (AndroidFramework.is_destroy_method curr_pname)) && PatternMatch.type_is_class t_lhs - && (not (Typ.Fieldname.is_java_outer_instance fname)) + && (not (Fieldname.is_java_outer_instance fname)) && (not (field_is_injector_readwrite ())) && not (field_is_in_cleanup_context ()) in @@ -192,7 +192,7 @@ let is_field_declared_as_nonnull annotated_field_opt = let lookup_field_in_typestate pname field_name typestate = - let pvar = Pvar.mk (Mangled.from_string (Typ.Fieldname.to_string field_name)) pname in + let pvar = Pvar.mk (Mangled.from_string (Fieldname.to_string field_name)) pname in TypeState.lookup_pvar pvar typestate @@ -281,14 +281,14 @@ let check_constructor_initialization tenv find_canonical_duplicate curr_construc in let should_check_field_initialization = let in_current_class = - let fld_cname = Typ.Fieldname.get_class_name field_name in + let fld_cname = Fieldname.get_class_name field_name in Typ.Name.equal name fld_cname in (not is_injector_readonly_annotated) (* primitive types can not be null so initialization check is not needed *) && PatternMatch.type_is_class field_type && in_current_class - && not (Typ.Fieldname.is_java_outer_instance field_name) + && not (Fieldname.is_java_outer_instance field_name) in if should_check_field_initialization then ( (* Check if non-null field is not initialized. *) diff --git a/infer/src/nullsafe/typeCheck.ml b/infer/src/nullsafe/typeCheck.ml index f3ae72892..8403a11e1 100644 --- a/infer/src/nullsafe/typeCheck.ml +++ b/infer/src/nullsafe/typeCheck.ml @@ -58,7 +58,7 @@ module ComplexExpressions = struct | DExp.Darray (de1, de2) -> dexp_to_string de1 ^ "[" ^ dexp_to_string de2 ^ "]" | DExp.Darrow (de, f) | DExp.Ddot (de, f) -> - dexp_to_string de ^ "." ^ Typ.Fieldname.to_string f + dexp_to_string de ^ "." ^ Fieldname.to_string f | DExp.Dbinop (op, de1, de2) -> "(" ^ dexp_to_string de1 ^ Binop.str Pp.text op ^ dexp_to_string de2 ^ ")" | DExp.Dconst (Const.Cfun pn) -> @@ -314,15 +314,15 @@ let convert_complex_exp_to_pvar tenv idenv curr_pname let res = match exp' with | Exp.Lvar pv when is_parameter_field pv || is_static_field pv -> - let fld_name = pvar_to_str pv ^ Typ.Fieldname.to_string fn in + let fld_name = pvar_to_str pv ^ Fieldname.to_string fn in let pvar = Pvar.mk (Mangled.from_string fld_name) curr_pname in let typestate' = update_typestate_fld ~is_assignment tenv loc typestate pvar inner_origin fn typ in (Exp.Lvar pvar, typestate') - | Exp.Lfield (_exp', fn', _) when Typ.Fieldname.is_java_outer_instance fn' -> + | Exp.Lfield (_exp', fn', _) when Fieldname.is_java_outer_instance fn' -> (* handle double dereference when accessing a field from an outer class *) - let fld_name = Typ.Fieldname.to_string fn' ^ "_" ^ Typ.Fieldname.to_string fn in + let fld_name = Fieldname.to_string fn' ^ "_" ^ Fieldname.to_string fn in let pvar = Pvar.mk (Mangled.from_string fld_name) curr_pname in let typestate' = update_typestate_fld ~is_assignment tenv loc typestate pvar inner_origin fn typ diff --git a/infer/src/nullsafe/typeErr.ml b/infer/src/nullsafe/typeErr.ml index 38ac87d11..ac3622288 100644 --- a/infer/src/nullsafe/typeErr.ml +++ b/infer/src/nullsafe/typeErr.ml @@ -64,7 +64,7 @@ type err_instance = ; violation_type: InheritanceRule.violation_type ; base_proc_name: Typ.Procname.t ; overridden_proc_name: Typ.Procname.t } - | Field_not_initialized of Typ.Fieldname.t + | Field_not_initialized of Fieldname.t | Over_annotation of { over_annotated_violation: OverAnnotatedRule.violation ; violation_type: OverAnnotatedRule.violation_type } @@ -190,7 +190,7 @@ type st_report_error = -> Procdesc.t -> IssueType.t -> Location.t - -> ?field_name:Typ.Fieldname.t option + -> ?field_name:Fieldname.t option -> ?exception_kind:(IssueType.t -> Localise.error_desc -> exn) -> ?severity:Exceptions.severity -> string @@ -232,7 +232,7 @@ let get_error_info err_instance = "Field %a is declared non-nullable, so it should be initialized in the constructor or in \ an `@Initializer` method" MF.pp_monospaced - (Typ.Fieldname.get_field_name field_name) + (Fieldname.get_field_name field_name) , IssueType.eradicate_field_not_initialized , None ) | Bad_assignment {rhs_origin; assignment_location; assignment_type; assignment_violation} -> diff --git a/infer/src/nullsafe/typeErr.mli b/infer/src/nullsafe/typeErr.mli index 444ce33b9..f27800514 100644 --- a/infer/src/nullsafe/typeErr.mli +++ b/infer/src/nullsafe/typeErr.mli @@ -40,7 +40,7 @@ type err_instance = ; violation_type: InheritanceRule.violation_type ; base_proc_name: Typ.Procname.t ; overridden_proc_name: Typ.Procname.t } - | Field_not_initialized of Typ.Fieldname.t + | Field_not_initialized of Fieldname.t | Over_annotation of { over_annotated_violation: OverAnnotatedRule.violation ; violation_type: OverAnnotatedRule.violation_type } @@ -64,7 +64,7 @@ type st_report_error = -> Procdesc.t -> IssueType.t -> Location.t - -> ?field_name:Typ.Fieldname.t option + -> ?field_name:Fieldname.t option -> ?exception_kind:(IssueType.t -> Localise.error_desc -> exn) -> ?severity:Exceptions.severity -> string diff --git a/infer/src/nullsafe/typeOrigin.ml b/infer/src/nullsafe/typeOrigin.ml index 6bde229ce..d406ab44b 100644 --- a/infer/src/nullsafe/typeOrigin.ml +++ b/infer/src/nullsafe/typeOrigin.ml @@ -33,7 +33,7 @@ type t = and field_origin = { object_origin: t (** field's object origin (object is before field access operator `.`) *) - ; field_name: Typ.Fieldname.t + ; field_name: Fieldname.t ; field_type: AnnotatedType.t ; access_loc: Location.t } @@ -78,7 +78,7 @@ let rec to_string = function | NonnullConst _ -> "Const (nonnull)" | Field {object_origin; field_name} -> - "Field " ^ Typ.Fieldname.to_string field_name ^ " (object: " ^ to_string object_origin ^ ")" + "Field " ^ Fieldname.to_string field_name ^ " (object: " ^ to_string object_origin ^ ")" | MethodParameter {mangled; param_annotated_type= {nullability}} -> Format.asprintf "Param %s <%a>" (Mangled.to_string mangled) AnnotatedNullability.pp nullability @@ -142,7 +142,7 @@ let get_description origin = | NullConst loc -> Some ("null constant" ^ atline loc) | Field {field_name; access_loc} -> - Some ("field " ^ Typ.Fieldname.get_field_name field_name ^ atline access_loc) + Some ("field " ^ Fieldname.get_field_name field_name ^ atline access_loc) | MethodParameter {mangled} -> Some ("method parameter " ^ Mangled.to_string mangled) | MethodCall {pname; call_loc; annotated_signature} -> diff --git a/infer/src/nullsafe/typeOrigin.mli b/infer/src/nullsafe/typeOrigin.mli index baed18f14..1ca75740e 100644 --- a/infer/src/nullsafe/typeOrigin.mli +++ b/infer/src/nullsafe/typeOrigin.mli @@ -31,7 +31,7 @@ type t = and field_origin = { object_origin: t (** field's object origin (object is before field access operator `.`) *) - ; field_name: Typ.Fieldname.t + ; field_name: Fieldname.t ; field_type: AnnotatedType.t ; access_loc: Location.t } diff --git a/infer/src/pulse/PulseModels.ml b/infer/src/pulse/PulseModels.ml index f8fec8d44..78b79d5a9 100644 --- a/infer/src/pulse/PulseModels.ml +++ b/infer/src/pulse/PulseModels.ml @@ -90,7 +90,7 @@ end module StdAtomicInteger = struct let internal_int = - Typ.Fieldname.make + Fieldname.make (Typ.CStruct (QualifiedCppName.of_list ["std"; "atomic"])) "__infer_model_backing_int" @@ -213,7 +213,7 @@ end module StdBasicString = struct let internal_string = - Typ.Fieldname.make + Fieldname.make (Typ.CStruct (QualifiedCppName.of_list ["std"; "basic_string"])) "__infer_model_backing_string" @@ -270,7 +270,7 @@ end module StdVector = struct let internal_array = - Typ.Fieldname.make + Fieldname.make (Typ.CStruct (QualifiedCppName.of_list ["std"; "vector"])) "__infer_model_backing_array" diff --git a/infer/src/pulse/PulseOperations.ml b/infer/src/pulse/PulseOperations.ml index 27207a6b7..a09a3d55f 100644 --- a/infer/src/pulse/PulseOperations.ml +++ b/infer/src/pulse/PulseOperations.ml @@ -28,7 +28,7 @@ module Closures = struct let fake_capture_field_prefix = "__capture_" let mk_fake_field ~id = - Typ.Fieldname.make + Fieldname.make (Typ.CStruct (QualifiedCppName.of_list ["std"; "function"])) (Printf.sprintf "%s%d" fake_capture_field_prefix id) @@ -36,7 +36,7 @@ module Closures = struct let is_captured_fake_access (access : _ HilExp.Access.t) = match access with | FieldAccess fieldname - when String.is_prefix ~prefix:fake_capture_field_prefix (Typ.Fieldname.to_string fieldname) -> + when String.is_prefix ~prefix:fake_capture_field_prefix (Fieldname.to_string fieldname) -> true | _ -> false diff --git a/infer/src/pulse/PulseOperations.mli b/infer/src/pulse/PulseOperations.mli index 21779b80f..c4b744ef5 100644 --- a/infer/src/pulse/PulseOperations.mli +++ b/infer/src/pulse/PulseOperations.mli @@ -61,7 +61,7 @@ val havoc_id : Ident.t -> ValueHistory.t -> t -> t val havoc_field : Location.t -> AbstractValue.t * ValueHistory.t - -> Typ.Fieldname.t + -> Fieldname.t -> ValueHistory.t -> t -> t access_result diff --git a/infer/src/topl/Topl.ml b/infer/src/topl/Topl.ml index 4cfc9ec16..d28a5efc6 100644 --- a/infer/src/topl/Topl.ml +++ b/infer/src/topl/Topl.ml @@ -162,7 +162,7 @@ let instrument tenv procdesc = + the prover fails to see that 0!=o.f * o|-f->0 is inconsistent *) let lookup_static_var env (var : Exp.t) (prop : 'a Prop.t) : Exp.t option = let from_strexp = function Predicates.Eexp (e, _) -> Some e | _ -> None in - let get_field field (f, e) = if Typ.Fieldname.equal field f then from_strexp e else None in + let get_field field (f, e) = if Fieldname.equal field f then from_strexp e else None in let get_strexp field = function | Predicates.Estruct (fs, _inst) -> List.find_map ~f:(get_field field) fs diff --git a/infer/src/topl/ToplUtils.ml b/infer/src/topl/ToplUtils.ml index 543ac482b..0962395e7 100644 --- a/infer/src/topl/ToplUtils.ml +++ b/infer/src/topl/ToplUtils.ml @@ -35,7 +35,7 @@ let topl_class_exp = let make_field field_name = - Typ.Fieldname.make (Typ.Name.Java.from_string ToplName.topl_property) field_name + Fieldname.make (Typ.Name.Java.from_string ToplName.topl_property) field_name let static_var x : Exp.t = Exp.Lfield (topl_class_exp, make_field x, topl_class_typ) diff --git a/infer/src/topl/ToplUtils.mli b/infer/src/topl/ToplUtils.mli index eba412e7b..5e69b456d 100644 --- a/infer/src/topl/ToplUtils.mli +++ b/infer/src/topl/ToplUtils.mli @@ -31,4 +31,4 @@ val is_synthesized : Typ.Procname.t -> bool val debug : ('a, Format.formatter, unit) IStd.format -> 'a -val make_field : string -> Typ.Fieldname.t +val make_field : string -> Fieldname.t diff --git a/infer/src/unit/accessPathTestUtils.ml b/infer/src/unit/accessPathTestUtils.ml index 20234735b..db36cc3ca 100644 --- a/infer/src/unit/accessPathTestUtils.ml +++ b/infer/src/unit/accessPathTestUtils.ml @@ -13,7 +13,7 @@ let make_base ?(typ = Typ.mk Tvoid) base_str = AccessPath.base_of_pvar (make_var let make_fieldname field_name = assert (not (String.contains field_name '.')) ; - Typ.Fieldname.make (Typ.Name.Java.from_string "SomeClass") field_name + Fieldname.make (Typ.Name.Java.from_string "SomeClass") field_name let make_field_access access_str = AccessPath.FieldAccess (make_fieldname access_str) diff --git a/infer/src/unit/accessPathTestUtils.mli b/infer/src/unit/accessPathTestUtils.mli index 87b658511..4d40618af 100644 --- a/infer/src/unit/accessPathTestUtils.mli +++ b/infer/src/unit/accessPathTestUtils.mli @@ -9,7 +9,7 @@ open! IStd val make_var : string -> Pvar.t -val make_fieldname : string -> Typ.Fieldname.t +val make_fieldname : string -> Fieldname.t val make_base : ?typ:Typ.t -> string -> AccessPath.base