From 44f41d2929da8a7ef5be4266b20f5fbbb8e9cf70 Mon Sep 17 00:00:00 2001 From: Artem Pianykh Date: Mon, 17 Feb 2020 07:10:14 -0800 Subject: [PATCH] [infer] Extend annotation framework to handle wider variety of param types Summary: Previous implementation supported only stringy params (strings and stringified bools). Current one exposes a proper variant `Annot.t`, with support for all possible param values in Java except numbers (more on that below). This change is required for implementing `Nullsafe(LOCAL)` as the annotation used to specify nullsafe behaviour has a more complex structure than what we've dealt with before. **Why support for number values was not added**: supporting numbers requires using `int64`. Unfortunately, adding another variant `Vnum int64` to `Annot.t` causes a runtime failure on assert in `MaximumSharing.ml:133`. It seems that it might be enough to flip `fail_on_nonstring` from `true` to `false`, but since this would require additional testing and is not required for my case, I'll leave checking this to whoever needs to use numeric annot params in future. Reviewed By: ezgicicek Differential Revision: D19855923 fbshipit-source-id: 878e33856 --- infer/src/IR/Annot.ml | 62 ++++++++++++++++----- infer/src/IR/Annot.mli | 25 ++++++--- infer/src/IR/Typ.ml | 2 + infer/src/IR/Typ.mli | 2 + infer/src/backend/reporting.ml | 5 +- infer/src/biabduction/Rearrange.ml | 10 +++- infer/src/biabduction/RetainCycles.ml | 7 ++- infer/src/checkers/RequiredProps.ml | 11 ++-- infer/src/clang/cField_decl.ml | 6 +- infer/src/concurrency/RacerD.ml | 7 ++- infer/src/concurrency/RacerDModels.ml | 4 +- infer/src/java/jAnnotation.ml | 80 ++++++++++++++++++++++----- 12 files changed, 169 insertions(+), 52 deletions(-) diff --git a/infer/src/IR/Annot.ml b/infer/src/IR/Annot.ml index 4bf38008b..c50a665fc 100644 --- a/infer/src/IR/Annot.ml +++ b/infer/src/IR/Annot.ml @@ -11,15 +11,22 @@ open! IStd module F = Format -type parameter = {name: string option; value: string} [@@deriving compare] +(** Type to represent an [@Annotation] with potentially complex parameter values such as arrays or + other annotations. *) +type t = {class_name: string (** name of the annotation *); parameters: parameter list} +[@@deriving compare] -type parameters = parameter list [@@deriving compare] +and parameter = {name: string option; value: value} [@@deriving compare] -(** Type to represent one [@Annotation]. *) -type t = - { class_name: string (** name of the annotation *) - ; parameters: parameters (** currently only one string parameter *) } -[@@deriving compare] +(** Type to represent possible annotation parameter values. Note that support for numeric parameters + is missing for now due to an issue with [MaximumSharing] and [int64]. *) +and value = + | Str of string + | Bool of bool + | Enum of {class_typ: Typ.t; value: string} + | Array of value list + | Class of Typ.t + | Annot of t let equal = [%compare.equal: t] @@ -29,22 +36,47 @@ let final = {class_name= "final"; parameters= []} let is_final x = equal final x +let rec has_matching_str_value ~pred = function + | Str s -> + pred s + | Array els -> + List.exists els ~f:(has_matching_str_value ~pred) + | _ -> + false + + (** Pretty print an annotation. *) let prefix = match Language.curr_language_is Java with true -> "@" | false -> "_" -let pp_parameter fmt {name; value} = +let comma_sep fmt _ = F.pp_print_string fmt ", " + +let rec pp_value fmt = function + | Str s -> + F.pp_print_string fmt s + | Bool b -> + F.pp_print_bool fmt b + | Enum {class_typ; value} -> + F.fprintf fmt "%a.%s" (Typ.pp Pp.text) class_typ value + | Array values -> + F.pp_print_list ~pp_sep:comma_sep pp_value fmt values + | Class name -> + F.fprintf fmt "%a" (Typ.pp Pp.text) name + | Annot a -> + F.fprintf fmt "%a" pp a + + +and pp_parameter fmt {name; value} = match name with | None -> - F.fprintf fmt "\"%s\"" value + F.fprintf fmt "\"%a\"" pp_value value | Some name -> - F.fprintf fmt "%s=\"%s\"" name value + F.fprintf fmt "%s=\"%a\"" name pp_value value -let pp fmt annotation = - let pp_sep fmt _ = F.pp_print_string fmt ", " in - F.fprintf fmt "%s%s%a" prefix annotation.class_name - (F.pp_print_list ~pp_sep pp_parameter) - annotation.parameters +and pp fmt annotation = + F.fprintf fmt "%s%s" prefix annotation.class_name ; + if not (List.is_empty annotation.parameters) then + F.fprintf fmt "(%a)" (F.pp_print_list ~pp_sep:comma_sep pp_parameter) annotation.parameters module Item = struct diff --git a/infer/src/IR/Annot.mli b/infer/src/IR/Annot.mli index b60b1982c..6d85afd78 100644 --- a/infer/src/IR/Annot.mli +++ b/infer/src/IR/Annot.mli @@ -11,15 +11,22 @@ open! IStd module F = Format -type parameter = {name: string option; value: string} +(** Type to represent an [@Annotation] with potentially complex parameter values such as arrays or + other annotations. *) +type t = {class_name: string (** name of the annotation *); parameters: parameter list} +[@@deriving compare] -type parameters = parameter list +and parameter = {name: string option; value: value} [@@deriving compare] -(** Type to represent one [@Annotation]. *) -type t = - { class_name: string (** name of the annotation *) - ; parameters: parameters (** currently only one string parameter *) } -[@@deriving compare] +(** Type to represent possible annotation parameter values. Note that support for numeric parameters + is missing for now due to an issue with [MaximumSharing] and [int64]. *) +and value = + | Str of string + | Bool of bool + | Enum of {class_typ: Typ.t; value: string} + | Array of value list + | Class of Typ.t + | Annot of t val volatile : t (** annotation for fields marked with the "volatile" keyword *) @@ -27,6 +34,10 @@ val volatile : t val final : t (** annotation for fields marked with the "final" keyword *) +val has_matching_str_value : pred:(string -> bool) -> value -> bool +(** Check if annotation parameter value contains a string satisfying a predicate. For convenience it + works both with raw [Vstr] and [Vstr] inside [Varray]. *) + val pp : F.formatter -> t -> unit (** Pretty print an annotation. *) diff --git a/infer/src/IR/Typ.ml b/infer/src/IR/Typ.ml index 341395af6..140fa1b74 100644 --- a/infer/src/IR/Typ.ml +++ b/infer/src/IR/Typ.ml @@ -265,6 +265,8 @@ let mk_array ?default ?quals ?length ?stride elt : t = mk ?default ?quals (Tarray {elt; length; stride}) +let mk_struct name = mk (Tstruct name) + let void = mk Tvoid let void_star = mk (Tptr (mk Tvoid, Pk_pointer)) diff --git a/infer/src/IR/Typ.mli b/infer/src/IR/Typ.mli index 7f7af17a3..d9a47c926 100644 --- a/infer/src/IR/Typ.mli +++ b/infer/src/IR/Typ.mli @@ -134,6 +134,8 @@ val mk : ?default:t -> ?quals:type_quals -> desc -> t val mk_array : ?default:t -> ?quals:type_quals -> ?length:IntLit.t -> ?stride:IntLit.t -> t -> t (** Create an array type from a given element type. If [length] or [stride] value is given, use them as static length and size. *) +val mk_struct : name -> t + val void : t (** void type *) diff --git a/infer/src/backend/reporting.ml b/infer/src/backend/reporting.ml index 505e2eff3..dd2932960 100644 --- a/infer/src/backend/reporting.ml +++ b/infer/src/backend/reporting.ml @@ -126,7 +126,10 @@ let is_suppressed ?(field_name = None) tenv proc_desc kind = let annotation_matches (a : Annot.t) = let normalize str = Str.global_replace (Str.regexp "[_-]") "" (String.lowercase str) in let drop_prefix str = Str.replace_first (Str.regexp "^[A-Za-z]+_") "" str in - let normalized_equal s1 a2 = String.equal (normalize s1) (normalize a2.Annot.value) in + let normalized_equal s1 a2 = + Annot.( + has_matching_str_value a2.value ~pred:(fun s -> String.equal (normalize s1) (normalize s))) + in let is_parameter_suppressed () = String.is_suffix a.class_name ~suffix:Annotations.suppress_lint && List.exists ~f:(normalized_equal kind.IssueType.unique_id) a.parameters diff --git a/infer/src/biabduction/Rearrange.ml b/infer/src/biabduction/Rearrange.ml index 83c2404f5..489350972 100644 --- a/infer/src/biabduction/Rearrange.ml +++ b/infer/src/biabduction/Rearrange.ml @@ -758,7 +758,7 @@ let add_guarded_by_constraints tenv prop lexp pdesc = let annot_extract_guarded_by_str ((annot : Annot.t), _) = if Annotations.annot_ends_with annot Annotations.guarded_by then match annot.parameters with - | [Annot.{value= guarded_by_str}] when not (excluded_guardedby_string guarded_by_str) -> + | [Annot.{value= Str guarded_by_str}] when not (excluded_guardedby_string guarded_by_str) -> Some guarded_by_str | _ -> None @@ -769,7 +769,13 @@ let add_guarded_by_constraints tenv prop lexp pdesc = let extract_suppress_warnings_str item_annot = let annot_suppress_warnings_str ((annot : Annot.t), _) = if Annotations.annot_ends_with annot Annotations.suppress_lint then - match annot.parameters with [Annot.{value= suppr_str}] -> Some suppr_str | _ -> None + (* TODO: @SuppressLint's param is an array of strings, thus we need to match on + array. But generally logic here is still broken since it only expects 1 value. *) + match annot.parameters with + | [Annot.{value= Array [Str suppr_str; _]}] -> + Some suppr_str + | _ -> + None else None in List.find_map ~f:annot_suppress_warnings_str item_annot diff --git a/infer/src/biabduction/RetainCycles.ml b/infer/src/biabduction/RetainCycles.ml index 4144fd1ed..199fe39d6 100644 --- a/infer/src/biabduction/RetainCycles.ml +++ b/infer/src/biabduction/RetainCycles.ml @@ -66,9 +66,10 @@ let edge_is_strong tenv obj_edge = in let has_weak_or_unretained_or_assign params = List.exists - ~f:(fun Annot.{value= att} -> - String.equal Config.unsafe_unret att - || String.equal Config.weak att || String.equal Config.assign att ) + ~f:(fun Annot.{value} -> + Annot.has_matching_str_value value ~pred:(fun att -> + String.equal Config.unsafe_unret att + || String.equal Config.weak att || String.equal Config.assign att ) ) params in let rc_field = diff --git a/infer/src/checkers/RequiredProps.ml b/infer/src/checkers/RequiredProps.ml index a9f0cb802..5d3580bf3 100644 --- a/infer/src/checkers/RequiredProps.ml +++ b/infer/src/checkers/RequiredProps.ml @@ -28,8 +28,7 @@ let get_required_props typename tenv = not (List.exists ~f:(fun Annot.{name; value} -> - Option.value_map name ~default:false ~f:(fun name -> String.equal "optional" name) - && String.equal value "true" ) + match (name, value) with Some "optional", Annot.Bool true -> true | _ -> false ) parameters) ) annot_list in @@ -41,9 +40,11 @@ let get_required_props typename tenv = @Prop(varArg = myProp). *) List.fold ~init:acc ~f:(fun acc Annot.{name; value} -> - if Option.value_map name ~default:false ~f:(fun name -> String.equal "varArg" name) - then Some value - else acc ) + match (name, value) with + | Some "varArg", Annot.Str str_value -> + Some str_value + | _ -> + acc ) parameters else acc ) annot_list diff --git a/infer/src/clang/cField_decl.ml b/infer/src/clang/cField_decl.ml index e8eb14028..d12e25b45 100644 --- a/infer/src/clang/cField_decl.ml +++ b/infer/src/clang/cField_decl.ml @@ -42,15 +42,15 @@ let fields_superclass tenv interface_decl_info = let build_sil_field qual_type_to_sil_type tenv class_tname field_name qual_type prop_attributes = let prop_atts = List.map - ~f:(fun att -> Annot.{name= None; value= Clang_ast_j.string_of_property_attribute att}) + ~f:(fun att -> Annot.{name= None; value= Str (Clang_ast_j.string_of_property_attribute att)}) prop_attributes in let annotation_from_type t = match t.Typ.desc with | Typ.Tptr (_, Typ.Pk_objc_weak) -> - [Annot.{name= None; value= Config.weak}] + [Annot.{name= None; value= Str Config.weak}] | Typ.Tptr (_, Typ.Pk_objc_unsafe_unretained) -> - [Annot.{name= None; value= Config.unsafe_unret}] + [Annot.{name= None; value= Str Config.unsafe_unret}] | _ -> [] in diff --git a/infer/src/concurrency/RacerD.ml b/infer/src/concurrency/RacerD.ml index a7aababc2..b4f990262 100644 --- a/infer/src/concurrency/RacerD.ml +++ b/infer/src/concurrency/RacerD.ml @@ -876,7 +876,12 @@ let should_report_guardedby_violation classname ({snapshot; tenv; procname} : re 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 ) + && + match annot.parameters with + | [param] -> + not (Annot.has_matching_str_value ~pred:is_uitthread param.value) + | _ -> + false ) in (not snapshot.lock) && RacerDDomain.TraceElem.is_write snapshot.access diff --git a/infer/src/concurrency/RacerDModels.ml b/infer/src/concurrency/RacerDModels.ml index 6a8518562..47037fdb3 100644 --- a/infer/src/concurrency/RacerDModels.ml +++ b/infer/src/concurrency/RacerDModels.ml @@ -277,7 +277,7 @@ let is_thread_safe item_annot = List.exists ~f:(Annotations.annot_ends_with annot) threadsafe_annotations && match annot.Annot.parameters with - | [Annot.{name= Some "enableChecks"; value= "false"}] -> + | [Annot.{name= Some "enableChecks"; value= Bool false}] -> false | _ -> true @@ -291,7 +291,7 @@ let is_assumed_thread_safe item_annot = Annotations.annot_ends_with annot Annotations.thread_safe && match annot.Annot.parameters with - | [Annot.{name= Some "enableChecks"; value= "false"}] -> + | [Annot.{name= Some "enableChecks"; value= Bool false}] -> true | _ -> false diff --git a/infer/src/java/jAnnotation.ml b/infer/src/java/jAnnotation.ml index 4d47d1352..d670f924f 100644 --- a/infer/src/java/jAnnotation.ml +++ b/infer/src/java/jAnnotation.ml @@ -9,21 +9,75 @@ open! IStd open Javalib_pack +let translate_basic_type = function + | `Bool -> + Typ.boolean + | `Byte -> + Typ.java_byte + | `Char -> + Typ.char + | `Double -> + Typ.double + | `Float -> + Typ.float + | `Int -> + Typ.int + | `Long -> + Typ.long + | `Short -> + Typ.java_short + + +let rec translate_value_type = function + | JBasics.TBasic basic -> + translate_basic_type basic + | JBasics.TObject obj -> + translate_object_type obj + + +and translate_object_type = function + | JBasics.TClass cn -> + Typ.mk_struct (Typ.Name.Java.from_string (JBasics.cn_name cn)) + | JBasics.TArray vt -> + Typ.mk_array (translate_value_type vt) + + +let rec translate_value_exn = function + | JBasics.EVCstString s -> + Annot.Str s + | JBasics.EVCstBoolean 0 -> + Annot.Bool false + | JBasics.EVCstBoolean 1 -> + Annot.Bool true + | JBasics.EVEnum (cn, value) -> + Annot.Enum {class_typ= Typ.mk_struct (Typ.Name.Java.from_string (JBasics.cn_name cn)); value} + | JBasics.EVArray values -> + Annot.Array (List.map values ~f:translate_value |> List.filter_opt) + | JBasics.EVClass (Some typ) -> + Annot.Class (translate_value_type typ) + | JBasics.EVClass _ -> + Annot.Class Typ.void + | JBasics.EVAnnotation ann -> + Annot.Annot (translate ann) + | _ -> + raise (Invalid_argument "Annotation value not supported") + + +and translate_value element_value = + match translate_value_exn element_value with + | value -> + Some value + | exception Invalid_argument _ -> + None + + (** Translate an annotation. *) -let translate a : Annot.t = +and translate a : Annot.t = let class_name = JBasics.cn_name a.JBasics.kind in - let rec translate_value_pair acc (x, value) = - match value with - | JBasics.EVArray (JBasics.EVCstString s :: l) -> - translate_value_pair (Annot.{name= Some x; value= s} :: acc) (x, JBasics.EVArray l) - | JBasics.EVCstString s -> - Annot.{name= Some x; value= s} :: acc - | JBasics.EVCstBoolean 0 -> - (* just translate bools as strings. means we can't distinguish between a boolean false - literal parameter and string literal "false" parameter, but that's ok. *) - Annot.{name= Some x; value= "false"} :: acc - | JBasics.EVCstBoolean 1 -> - Annot.{name= Some x; value= "true"} :: acc + let translate_value_pair acc (x, value) = + match translate_value value with + | Some translated -> + Annot.{name= Some x; value= translated} :: acc | _ -> acc in