diff --git a/infer/src/nullsafe/AnnotatedField.ml b/infer/src/nullsafe/AnnotatedField.ml index 0be191f46..ba7cb87ae 100644 --- a/infer/src/nullsafe/AnnotatedField.ml +++ b/infer/src/nullsafe/AnnotatedField.ml @@ -38,7 +38,18 @@ let is_enum_value tenv ~class_typ (field_info : Struct.field_info) = let is_synthetic field_name = String.contains field_name '$' -let get tenv field_name class_typ = +(* For the special mode, return the provisionally nullable annotation, otherwise return the unchaged nullability *) +let maybe_provisionally_nullable field_name ~field_class ~class_under_analysis nullability = + if + Config.nullsafe_annotation_graph + (* Provisionally nullable mode distinct "internal" fields in the class and all the fields outside *) + && Typ.Name.equal field_class class_under_analysis + && AnnotatedNullability.can_be_considered_for_provisional_annotation nullability + then AnnotatedNullability.ProvisionallyNullable (ProvisionalAnnotation.Field {field_name}) + else nullability + + +let get tenv field_name ~class_typ ~class_under_analysis = let open IOption.Let_syntax in let lookup = Tenv.lookup tenv in (* We currently don't support field-level strict mode annotation, so fetch it from class *) @@ -63,7 +74,7 @@ let get tenv field_name class_typ = AnnotatedNullability.of_type_and_annotation ~is_callee_in_trust_list:false ~nullsafe_mode ~is_third_party field_typ annotations in - let corrected_nullability = + let special_case_nullability = if Nullability.is_nonnullish (AnnotatedNullability.get_nullability nullability) then if is_enum_value @@ -81,5 +92,13 @@ let get tenv field_name class_typ = else nullability else nullability in - let annotated_type = AnnotatedType.{nullability= corrected_nullability; typ= field_typ} in + let field_class = + Option.value_exn (get_type_name class_typ) + ~message:"otherwise we would not have fetched field info above" + in + let final_nullability = + maybe_provisionally_nullable field_name ~field_class ~class_under_analysis + special_case_nullability + in + let annotated_type = AnnotatedType.{nullability= final_nullability; typ= field_typ} in {annotation_deprecated= annotations; annotated_type} diff --git a/infer/src/nullsafe/AnnotatedField.mli b/infer/src/nullsafe/AnnotatedField.mli index 3dbd768aa..0370be6c3 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 -> Fieldname.t -> Typ.t -> t option +val get : Tenv.t -> Fieldname.t -> class_typ:Typ.t -> class_under_analysis:Typ.name -> t option (** Looks up for a field declaration and, in case of success, converts it to [t] *) diff --git a/infer/src/nullsafe/AnnotatedNullability.ml b/infer/src/nullsafe/AnnotatedNullability.ml index 033b379f0..cae84668c 100644 --- a/infer/src/nullsafe/AnnotatedNullability.ml +++ b/infer/src/nullsafe/AnnotatedNullability.ml @@ -145,3 +145,26 @@ let of_type_and_annotation ~is_callee_in_trust_list ~nullsafe_mode ~is_third_par else UncheckedNonnull ImplicitlyNonnull in if is_callee_in_trust_list then LocallyTrustedNonnull else preliminary_nullability + + +let can_be_considered_for_provisional_annotation = function + | Nullable _ -> + (* already nullable *) false + | ProvisionallyNullable _ -> + (* already provisionally nullable *) true + | ThirdPartyNonnull -> + (* third party code is considered beyond control *) false + | UncheckedNonnull _ | LocallyTrustedNonnull | LocallyCheckedNonnull -> + (* legit non-primitive non-nullable type *) true + | StrictNonnull ExplicitNonnullThirdParty -> + (* third party code is considered beyond control *) false + | StrictNonnull ModelledNonnull -> + (* models correspond to code beyond control *) false + | StrictNonnull PrimitiveType -> + (* primitive type can not be annotated *) false + | StrictNonnull EnumValue -> + (* by design non-nullable *) false + | StrictNonnull SyntheticField -> + (* not present in source code *) false + | StrictNonnull StrictMode -> + (* legit non-nullable non-primitive type *) true diff --git a/infer/src/nullsafe/AnnotatedNullability.mli b/infer/src/nullsafe/AnnotatedNullability.mli index 152248583..fb74e81f6 100644 --- a/infer/src/nullsafe/AnnotatedNullability.mli +++ b/infer/src/nullsafe/AnnotatedNullability.mli @@ -81,4 +81,12 @@ val of_type_and_annotation : processing. [is_callee_in_trust_list] defines whether the callee class is in the caller's explicitly provided trust list and therefore whether its nullability should be refined. *) +val can_be_considered_for_provisional_annotation : t -> bool +(** A method for the special mode where imaginary (provisional) [@Nullable] annotations are added to + the code: see also [ProvisionalAnnotation.t]. This is a helper method useful for preliminary + filtration of types that: + + - can be semantically annotated as [@Nullable] in the source code e.g. non-primitive types + - makes logical sense to annotate - e.g. the source code is under control. *) + val pp : Format.formatter -> t -> unit diff --git a/infer/src/nullsafe/ProvisionalAnnotation.ml b/infer/src/nullsafe/ProvisionalAnnotation.ml index 8720488eb..045ee3b59 100644 --- a/infer/src/nullsafe/ProvisionalAnnotation.ml +++ b/infer/src/nullsafe/ProvisionalAnnotation.ml @@ -7,14 +7,14 @@ open! IStd type t = - | Field of {field_name: string} + | Field of {field_name: Fieldname.t} | Method of Procname.Java.t | Param of {method_info: Procname.Java.t; num: int} [@@deriving compare] let pp fmt = function | Field {field_name} -> - Format.fprintf fmt "Field(%s)" field_name + Format.fprintf fmt "Field(%a)" Fieldname.pp field_name | Method proc_name -> Format.fprintf fmt "Method(%a)" Procname.pp (Procname.Java proc_name) | Param {method_info; num} -> diff --git a/infer/src/nullsafe/ProvisionalAnnotation.mli b/infer/src/nullsafe/ProvisionalAnnotation.mli index 8ac289345..f69199d94 100644 --- a/infer/src/nullsafe/ProvisionalAnnotation.mli +++ b/infer/src/nullsafe/ProvisionalAnnotation.mli @@ -12,7 +12,7 @@ open! IStd and such * element was annotated as [@Nullable]. *) type t = - | Field of {field_name: string} + | Field of {field_name: Fieldname.t} | Method of Procname.Java.t | Param of {method_info: Procname.Java.t; num: int} [@@deriving compare] diff --git a/infer/src/nullsafe/eradicateChecks.ml b/infer/src/nullsafe/eradicateChecks.ml index e0b953e1f..a7984a46b 100644 --- a/infer/src/nullsafe/eradicateChecks.ml +++ b/infer/src/nullsafe/eradicateChecks.ml @@ -233,7 +233,9 @@ let check_constructor_initialization match Tenv.lookup tenv name with | Some {fields} -> let do_field (field_name, field_type, _) = - let annotated_field = AnnotatedField.get tenv field_name ts in + let annotated_field = + AnnotatedField.get tenv field_name ~class_typ:ts ~class_under_analysis:name + in let is_initialized_by_framework = match annotated_field with | None -> diff --git a/infer/src/nullsafe/typeCheck.ml b/infer/src/nullsafe/typeCheck.ml index 6bd821ccd..fa1e76098 100644 --- a/infer/src/nullsafe/typeCheck.ml +++ b/infer/src/nullsafe/typeCheck.ml @@ -117,9 +117,9 @@ type find_canonical_duplicate = Procdesc.Node.t -> Procdesc.Node.t type checks = {eradicate: bool; check_ret_type: check_return_type list} (** Typecheck an expression. *) -let rec typecheck_expr ({IntraproceduralAnalysis.tenv; _} as analysis_data) ~nullsafe_mode - find_canonical_duplicate visited checks node instr_ref typestate e tr_default loc : - TypeState.range = +let rec typecheck_expr ({IntraproceduralAnalysis.tenv; proc_desc= curr_proc_desc} as analysis_data) + ~nullsafe_mode find_canonical_duplicate visited checks node instr_ref typestate e tr_default loc + : TypeState.range = L.d_with_indent ~name:"typecheck_expr" ~pp_result:TypeState.pp_range (fun () -> L.d_printfln "Expr: %a" Exp.pp e ; match e with @@ -161,8 +161,14 @@ let rec typecheck_expr ({IntraproceduralAnalysis.tenv; _} as analysis_data) ~nul loc in let object_origin = InferredNullability.get_simple_origin inferred_nullability in + let curr_procname = + Procdesc.get_proc_name curr_proc_desc + |> Procname.as_java_exn + ~explanation:"typecheck_expr: attempt to typecheck non-Java method" + in + let class_under_analysis = Procname.Java.get_class_type_name curr_procname in let tr_new = - match AnnotatedField.get tenv field_name typ with + match AnnotatedField.get tenv field_name ~class_typ:typ ~class_under_analysis with | Some AnnotatedField.{annotated_type= field_type} -> ( field_type.typ , InferredNullability.create @@ -252,12 +258,13 @@ let funcall_exp_to_original_pvar_exp tenv curr_pname typestate exp ~is_assignmen exp -let add_field_to_typestate_if_absent tenv access_loc typestate pvar object_origin field_name typ = +let add_field_to_typestate_if_absent tenv access_loc typestate pvar object_origin field_name + ~field_class_typ ~class_under_analysis = match TypeState.lookup_pvar pvar typestate with | Some _ -> typestate | None -> ( - match AnnotatedField.get tenv field_name typ with + match AnnotatedField.get tenv field_name ~class_typ:field_class_typ ~class_under_analysis with | Some AnnotatedField.{annotated_type= field_type} -> let range = ( field_type.typ @@ -303,7 +310,7 @@ let convert_complex_exp_to_pvar_and_register_field_in_typestate tenv idenv curr_ default ) | Exp.Lvar _ -> default - | Exp.Lfield (exp_, fn, typ) -> + | Exp.Lfield (exp_, fn, field_class_typ) -> let inner_origin = ( match exp_ with | Exp.Lvar pvar -> @@ -330,13 +337,19 @@ let convert_complex_exp_to_pvar_and_register_field_in_typestate tenv idenv curr_ let pvar_to_str pvar = if Exp.is_this (Exp.Lvar pvar) then "" else Pvar.to_string pvar ^ "_" in + let class_under_analysis = + Procname.Java.get_class_type_name + (Procname.as_java_exn curr_pname + ~explanation:"Attempt to typecheck non-Java procname") + in let res = match exp' with | Exp.Lvar pv when is_parameter_field pv || is_static_field pv -> 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' = - add_field_to_typestate_if_absent tenv loc typestate pvar inner_origin fn typ + add_field_to_typestate_if_absent tenv loc typestate pvar inner_origin fn + ~field_class_typ ~class_under_analysis in (Exp.Lvar pvar, typestate') | Exp.Lfield (_exp', fn', _) when Fieldname.is_java_outer_instance fn' -> @@ -344,7 +357,8 @@ let convert_complex_exp_to_pvar_and_register_field_in_typestate tenv idenv curr_ 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' = - add_field_to_typestate_if_absent tenv loc typestate pvar inner_origin fn typ + add_field_to_typestate_if_absent tenv loc typestate pvar inner_origin fn + ~field_class_typ ~class_under_analysis in (Exp.Lvar pvar, typestate') | Exp.Lvar _ | Exp.Lfield _ -> ( @@ -353,7 +367,8 @@ let convert_complex_exp_to_pvar_and_register_field_in_typestate tenv idenv curr_ | Some exp_str -> let pvar = Pvar.mk (Mangled.from_string exp_str) curr_pname in let typestate' = - add_field_to_typestate_if_absent tenv loc typestate pvar inner_origin fn typ + add_field_to_typestate_if_absent tenv loc typestate pvar inner_origin fn + ~field_class_typ ~class_under_analysis in (Exp.Lvar pvar, typestate') | None -> @@ -1232,16 +1247,23 @@ let typecheck_instr ({IntraproceduralAnalysis.proc_desc= curr_pdesc; tenv; _} as let check_field_assign () = match e1 with | Exp.Lfield (_, field_name, field_class_type) -> ( - match AnnotatedField.get tenv field_name field_class_type with - | Some annotated_field -> - if checks.eradicate then - EradicateChecks.check_field_assignment analysis_data ~nullsafe_mode - find_canonical_duplicate node instr_ref typestate ~expr_rhs:e2 ~field_type:typ loc - field_name annotated_field - (typecheck_expr analysis_data ~nullsafe_mode find_canonical_duplicate calls_this - checks) - | None -> - L.d_strln "WARNING: could not fetch field declaration; skipping assignment check" ) + let class_under_analysis = + Procname.Java.get_class_type_name + (Procname.as_java_exn curr_pname + ~explanation:"Attempt to typecheck non-Java method") + in + match + AnnotatedField.get tenv field_name ~class_typ:field_class_type ~class_under_analysis + with + | Some annotated_field -> + if checks.eradicate then + EradicateChecks.check_field_assignment analysis_data ~nullsafe_mode + find_canonical_duplicate node instr_ref typestate ~expr_rhs:e2 ~field_type:typ + loc field_name annotated_field + (typecheck_expr analysis_data ~nullsafe_mode find_canonical_duplicate calls_this + checks) + | None -> + L.d_strln "WARNING: could not fetch field declaration; skipping assignment check" ) | _ -> () in