Feature nullness :: warn also for 'obj' type (since it can be infered for null literal) (#16962)

Author: T-Gro

src/Compiler/Checking/AugmentWithHashCompare.fs

@@ -15,7 +15,7 @@ open FSharp.Compiler.TypedTreeOps
 open FSharp.Compiler.TypeHierarchy
 
 let mkIComparableCompareToSlotSig (g: TcGlobals) =
-    TSlotSig("CompareTo", g.mk_IComparable_ty, [], [], [ [ TSlotParam(Some("obj"), g.obj_ty, false, false, false, []) ] ], Some g.int_ty)
+    TSlotSig("CompareTo", g.mk_IComparable_ty, [], [], [ [ TSlotParam(Some("obj"), g.obj_ty_withNulls, false, false, false, []) ] ], Some g.int_ty)
 
 let mkGenericIComparableCompareToSlotSig (g: TcGlobals) ty =
     TSlotSig(
@@ -35,7 +35,7 @@ let mkIStructuralComparableCompareToSlotSig (g: TcGlobals) =
         [],
         [
             [
-                TSlotParam(None, (mkRefTupledTy g [ g.obj_ty; g.IComparer_ty ]), false, false, false, [])
+                TSlotParam(None, (mkRefTupledTy g [ g.obj_ty_withNulls; g.IComparer_ty ]), false, false, false, [])
             ]
         ],
         Some g.int_ty
@@ -59,7 +59,7 @@ let mkIStructuralEquatableEqualsSlotSig (g: TcGlobals) =
         [],
         [
             [
-                TSlotParam(None, (mkRefTupledTy g [ g.obj_ty; g.IEqualityComparer_ty ]), false, false, false, [])
+                TSlotParam(None, (mkRefTupledTy g [ g.obj_ty_withNulls; g.IEqualityComparer_ty ]), false, false, false, [])
             ]
         ],
         Some g.bool_ty
@@ -76,10 +76,10 @@ let mkIStructuralEquatableGetHashCodeSlotSig (g: TcGlobals) =
     )
 
 let mkGetHashCodeSlotSig (g: TcGlobals) =
-    TSlotSig("GetHashCode", g.obj_ty, [], [], [ [] ], Some g.int_ty)
+    TSlotSig("GetHashCode", g.obj_ty_noNulls, [], [], [ [] ], Some g.int_ty)
 
 let mkEqualsSlotSig (g: TcGlobals) =
-    TSlotSig("Equals", g.obj_ty, [], [], [ [ TSlotParam(Some("obj"), g.obj_ty, false, false, false, []) ] ], Some g.bool_ty)
+    TSlotSig("Equals", g.obj_ty_noNulls, [], [], [ [ TSlotParam(Some("obj"), g.obj_ty_withNulls, false, false, false, []) ] ], Some g.bool_ty)
 
 //-------------------------------------------------------------------------
 // Helpers associated with code-generation of comparison/hash augmentations
@@ -89,22 +89,22 @@ let mkThisTy g ty =
     if isStructTy g ty then mkByrefTy g ty else ty
 
 let mkCompareObjTy g ty =
-    mkFunTy g (mkThisTy g ty) (mkFunTy g g.obj_ty g.int_ty)
+    mkFunTy g (mkThisTy g ty) (mkFunTy g g.obj_ty_withNulls g.int_ty)
 
 let mkCompareTy g ty =
     mkFunTy g (mkThisTy g ty) (mkFunTy g ty g.int_ty)
 
 let mkCompareWithComparerTy g ty =
-    mkFunTy g (mkThisTy g ty) (mkFunTy g (mkRefTupledTy g [ g.obj_ty; g.IComparer_ty ]) g.int_ty)
+    mkFunTy g (mkThisTy g ty) (mkFunTy g (mkRefTupledTy g [ g.obj_ty_withNulls; g.IComparer_ty ]) g.int_ty)
 
 let mkEqualsObjTy g ty =
-    mkFunTy g (mkThisTy g ty) (mkFunTy g g.obj_ty g.bool_ty)
+    mkFunTy g (mkThisTy g ty) (mkFunTy g g.obj_ty_withNulls g.bool_ty)
 
 let mkEqualsTy g ty =
     mkFunTy g (mkThisTy g ty) (mkFunTy g ty g.bool_ty)
 
 let mkEqualsWithComparerTy g ty =
-    mkFunTy g (mkThisTy g ty) (mkFunTy g (mkRefTupledTy g [ g.obj_ty; g.IEqualityComparer_ty ]) g.bool_ty)
+    mkFunTy g (mkThisTy g ty) (mkFunTy g (mkRefTupledTy g [ g.obj_ty_withNulls; g.IEqualityComparer_ty ]) g.bool_ty)
 
 let mkHashTy g ty =
     mkFunTy g (mkThisTy g ty) (mkFunTy g g.unit_ty g.int_ty)
@@ -1096,7 +1096,7 @@ let CheckAugmentationAttribs isImplementation g amap (tycon: Tycon) =
         hasNominalInterface g.system_GenericIComparable_tcref
 
     let hasExplicitEquals =
-        tycon.HasOverride g "Equals" [ g.obj_ty ]
+        tycon.HasOverride g "Equals" [ g.obj_ty_ambivalent ]
         || hasNominalInterface g.tcref_System_IStructuralEquatable
 
     let hasExplicitGenericEquals = hasNominalInterface g.system_GenericIEquatable_tcref
@@ -1351,13 +1351,13 @@ let MakeBindingsForCompareAugmentation g (tycon: Tycon) =
                 let tinst, ty = mkMinimalTy g tcref
 
                 let thisv, thise = mkThisVar g m ty
-                let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty
+                let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty_ambivalent
 
                 let comparee =
                     if isUnitTy g ty then
                         mkZero g m
                     else
-                        let thate = mkCoerceExpr (thatobje, ty, m, g.obj_ty)
+                        let thate = mkCoerceExpr (thatobje, ty, m, g.obj_ty_ambivalent)
 
                         mkApps g ((exprForValRef m vref2, vref2.Type), (if isNil tinst then [] else [ tinst ]), [ thise; thate ], m)
 
@@ -1394,8 +1394,8 @@ let MakeBindingsForCompareWithComparerAugmentation g (tycon: Tycon) =
             let compv, compe = mkCompGenLocal m "comp" g.IComparer_ty
 
             let thisv, thise = mkThisVar g m ty
-            let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty
-            let thate = mkCoerceExpr (thatobje, ty, m, g.obj_ty)
+            let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty_ambivalent
+            let thate = mkCoerceExpr (thatobje, ty, m, g.obj_ty_ambivalent)
 
             let rhs =
                 let comparee = comparef g tcref tycon (thisv, thise) (thatobjv, thate) compe
@@ -1453,7 +1453,7 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon: Tycon
             let withcEqualsExpr =
                 let _tinst, ty = mkMinimalTy g tcref
                 let thisv, thise = mkThisVar g m ty
-                let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty
+                let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty_ambivalent
                 let thatv, thate = mkCompGenLocal m "that" ty
                 let compv, compe = mkCompGenLocal m "comp" g.IEqualityComparer_ty
                 let equalse = equalsf g tcref tycon (thisv, thise) thatobje (thatv, thate) compe
@@ -1515,7 +1515,7 @@ let MakeBindingsForEqualsAugmentation (g: TcGlobals) (tycon: Tycon) =
                 let tinst, ty = mkMinimalTy g tcref
 
                 let thisv, thise = mkThisVar g m ty
-                let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty
+                let thatobjv, thatobje = mkCompGenLocal m "obj" g.obj_ty_ambivalent
 
                 let equalse =
                     if isUnitTy g ty then

src/Compiler/Checking/CheckDeclarations.fs

@@ -860,7 +860,7 @@ module AddAugmentationDeclarations =
             let m = tycon.Range
 
             // Note: tycon.HasOverride only gives correct results after we've done the type augmentation 
-            let hasExplicitObjectEqualsOverride = tycon.HasOverride g "Equals" [g.obj_ty]
+            let hasExplicitObjectEqualsOverride = tycon.HasOverride g "Equals" [g.obj_ty_ambivalent]
             let hasExplicitGenericIEquatable = tcaugHasNominalInterface g tcaug g.system_GenericIEquatable_tcref
 
             if hasExplicitGenericIEquatable then 
@@ -1610,7 +1610,7 @@ module MutRecBindingChecking =
                             if tcref.IsStructOrEnumTycon then 
                                 Some (incrCtorInfo, mkUnit g tcref.Range, false), defnCs
                             else
-                                let inheritsExpr, _ = TcNewExpr cenv envForDecls tpenv g.obj_ty None true (SynExpr.Const (SynConst.Unit, tcref.Range)) tcref.Range
+                                let inheritsExpr, _ = TcNewExpr cenv envForDecls tpenv g.obj_ty_noNulls None true (SynExpr.Const (SynConst.Unit, tcref.Range)) tcref.Range
 
                                 // If there is no 'inherits' and no simple non-static 'let' of a non-method then add a debug point at the entry to the constructor over the type name itself.
                                 let addDebugPointAtImplicitCtorArguments =
@@ -3313,7 +3313,7 @@ module EstablishTypeDefinitionCores =
                           if isTyparTy g ty then 
                               if firstPass then 
                                   errorR(Error(FSComp.SR.tcCannotInheritFromVariableType(), m)) 
-                              Some g.obj_ty // a "super" that is a variable type causes grief later
+                              Some g.obj_ty_noNulls // a "super" that is a variable type causes grief later
                           else                          
                               Some ty 
                       | _ -> 

src/Compiler/Checking/CheckExpressions.fs

@@ -3106,7 +3106,7 @@ let BuildDisposableCleanup (cenv: cenv) env m (v: Val) =
     else
         let disposeObjVar, disposeObjExpr = mkCompGenLocal m "objectToDispose" g.system_IDisposable_ty
         let disposeExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] None
-        let inputExpr = mkCoerceExpr(exprForVal v.Range v, g.obj_ty, m, v.Type)
+        let inputExpr = mkCoerceExpr(exprForVal v.Range v, g.obj_ty_ambivalent, m, v.Type)
         mkIsInstConditional g m g.system_IDisposable_ty inputExpr disposeObjVar disposeExpr (mkUnit g m)
 
 /// Build call to get_OffsetToStringData as part of 'fixed'
@@ -3346,7 +3346,7 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr
                         // e.g. MatchCollection
                         typeEquiv g g.int32_ty ty ||
                         // e.g. EnvDTE.Documents.Item
-                        typeEquiv g g.obj_ty ty
+                        typeEquiv g g.obj_ty_ambivalent ty
                     | _ -> false
 
                 match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AllResults cenv env m ad "get_Item" tyToSearchForGetEnumeratorAndItem with
@@ -4462,7 +4462,7 @@ and TcTypeOrMeasure kindOpt (cenv: cenv) newOk checkConstraints occ (iwsam: Warn
     match synTy with
     | SynType.LongIdent(SynLongIdent([], _, _)) ->
         // special case when type name is absent - i.e. empty inherit part in type declaration
-        g.obj_ty, tpenv
+        g.obj_ty_ambivalent, tpenv
 
     | SynType.LongIdent synLongId ->
         TcLongIdentType kindOpt cenv newOk checkConstraints occ iwsam env tpenv synLongId
@@ -5096,7 +5096,7 @@ and TcTypeOrMeasureAndRecover kindOpt (cenv: cenv) newOk checkConstraints occ iw
             match kindOpt, newOk with
             | Some TyparKind.Measure, NoNewTypars -> TType_measure Measure.One
             | Some TyparKind.Measure, _ -> TType_measure (NewErrorMeasure ())
-            | _, NoNewTypars -> g.obj_ty
+            | _, NoNewTypars -> g.obj_ty_ambivalent
             | _ -> NewErrorType ()
 
         recoveryTy, tpenv
@@ -7482,7 +7482,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn
 
                 let fillExprsBoxed = (argTys, fillExprs) ||> List.map2 (mkCallBox g m)
 
-                let argsExpr = mkArray (g.obj_ty, fillExprsBoxed, m)
+                let argsExpr = mkArray (g.obj_ty_withNulls, fillExprsBoxed, m)
                 let percentATysExpr =
                     if percentATys.Length = 0 then
                         mkNull m (mkArrayType g g.system_Type_ty)
@@ -7509,7 +7509,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn
         let fillExprsBoxed = (argTys, fillExprs) ||> List.map2 (mkCallBox g m)
 
         let dotnetFormatStringExpr = mkString g m dotnetFormatString
-        let argsExpr = mkArray (g.obj_ty, fillExprsBoxed, m)
+        let argsExpr = mkArray (g.obj_ty_withNulls, fillExprsBoxed, m)
 
         // FormattableString are *always* turned into FormattableStringFactory.Create calls, boxing each argument
         let createExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false createFormattableStringMethod NormalValUse [] [dotnetFormatStringExpr; argsExpr] [] None
@@ -9540,7 +9540,7 @@ and TcEventItemThen (cenv: cenv) overallTy env tpenv mItem mExprAndItem objDetai
                (let dv, de = mkCompGenLocal mItem "eventDelegate" delTy
                 let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false einfo.RemoveMethod NormalValUse [] objVars [de] None
                 mkLambda mItem dv (callExpr, g.unit_ty))
-               (let fvty = mkFunTy g g.obj_ty (mkFunTy g argsTy g.unit_ty)
+               (let fvty = mkFunTy g g.obj_ty_withNulls (mkFunTy g argsTy g.unit_ty)
                 let fv, fe = mkCompGenLocal mItem "callback" fvty
                 let createExpr = BuildNewDelegateExpr (Some einfo, g, cenv.amap, delTy, delInvokeMeth, delArgTys, fe, fvty, mItem)
                 mkLambda mItem fv (createExpr, delTy)))
@@ -9926,7 +9926,7 @@ and TcAdhocChecksOnLibraryMethods (cenv: cenv) (env: TcEnv) isInstance (finalCal
 
     if (isInstance &&
         finalCalledMethInfo.IsInstance &&
-        typeEquiv g finalCalledMethInfo.ApparentEnclosingType g.obj_ty &&
+        typeEquiv g finalCalledMethInfo.ApparentEnclosingType g.obj_ty_ambivalent &&
         (finalCalledMethInfo.LogicalName = "GetHashCode" || finalCalledMethInfo.LogicalName = "Equals")) then
 
         for objArg in objArgs do

src/Compiler/Checking/ConstraintSolver.fs

@@ -1050,12 +1050,8 @@ and SolveNullnessEquiv (csenv: ConstraintSolverEnv) m2 (trace: OptionalTrace) ty
         // TODO NULLNESS:  this is not sound in contravariant cases etc. It is assuming covariance.
         | NullnessInfo.WithNull, NullnessInfo.WithoutNull -> CompleteD
         | _ -> 
-            // NOTE: we never give nullness warnings for the 'obj' type
             if csenv.g.checkNullness then 
-                if not (isObjTy csenv.g ty1) || not (isObjTy csenv.g ty2) then 
-                    WarnD(ConstraintSolverNullnessWarningEquivWithTypes(csenv.DisplayEnv, ty1, ty2, n1, n2, csenv.m, m2)) 
-                else
-                    CompleteD
+                WarnD(ConstraintSolverNullnessWarningEquivWithTypes(csenv.DisplayEnv, ty1, ty2, n1, n2, csenv.m, m2))
             else
                 CompleteD
 
@@ -1088,11 +1084,8 @@ and SolveNullnessSubsumesNullness (csenv: ConstraintSolverEnv) m2 (trace: Option
         | NullnessInfo.WithNull, NullnessInfo.WithoutNull ->             
             CompleteD
         | NullnessInfo.WithoutNull, NullnessInfo.WithNull -> 
-            if csenv.g.checkNullness then 
-                if not (isObjTy csenv.g ty1) || not (isObjTy csenv.g ty2) then 
-                    WarnD(ConstraintSolverNullnessWarningWithTypes(csenv.DisplayEnv, ty1, ty2, n1, n2, csenv.m, m2)) 
-                else
-                    CompleteD
+            if csenv.g.checkNullness then               
+                 WarnD(ConstraintSolverNullnessWarningWithTypes(csenv.DisplayEnv, ty1, ty2, n1, n2, csenv.m, m2)) 
             else
                 CompleteD
 
@@ -2575,7 +2568,7 @@ and SolveNullnessSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 (trace: Opti
             | NullnessInfo.AmbivalentToNull -> ()
             | NullnessInfo.WithNull -> ()
             | NullnessInfo.WithoutNull -> 
-                if g.checkNullness && not (isObjTy g ty) then 
+                if g.checkNullness then 
                     return! WarnD(ConstraintSolverNullnessWarningWithType(denv, ty, n1, m, m2)) 
     }
 
@@ -2590,7 +2583,7 @@ and SolveTypeUseNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
             // code via Option.ofObj and Option.toObj
             do! WarnD (ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsTrueValue(NicePrint.minimalStringOfType denv ty), m, m2))
         elif TypeNullIsExtraValueNew g m ty then 
-            if g.checkNullness && not (isObjTy g ty) then
+            if g.checkNullness then
                 let denv = { denv with showNullnessAnnotations = Some true }
                 do! WarnD (ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalStringOfType denv ty), m, m2))
         else
@@ -2618,7 +2611,7 @@ and SolveNullnessNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 (trace: O
             | NullnessInfo.AmbivalentToNull -> ()
             | NullnessInfo.WithoutNull -> ()
             | NullnessInfo.WithNull -> 
-                if g.checkNullness && TypeNullIsExtraValueNew g m ty && not (isObjTy g ty) then
+                if g.checkNullness && TypeNullIsExtraValueNew g m ty then
                     let denv = { denv with showNullnessAnnotations = Some true }
                     return! WarnD(ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalStringOfType denv ty), m, m2))
     }

src/Compiler/Checking/MethodCalls.fs

@@ -1260,7 +1260,7 @@ let MethInfoChecks g amap isInstance tyargsOpt objArgs ad m (minfo: MethInfo)  =
 /// Build a call to the System.Object constructor taking no arguments,
 let BuildObjCtorCall (g: TcGlobals) m =
     let ilMethRef = (mkILCtorMethSpecForTy(g.ilg.typ_Object, [])).MethodRef
-    Expr.Op (TOp.ILCall (false, false, false, false, CtorValUsedAsSuperInit, false, true, ilMethRef, [], [], [g.obj_ty]), [], [], m)
+    Expr.Op (TOp.ILCall (false, false, false, false, CtorValUsedAsSuperInit, false, true, ilMethRef, [], [], [g.obj_ty_noNulls]), [], [], m)
 
 /// Implements the elaborated form of adhoc conversions from functions to delegates at member callsites
 let BuildNewDelegateExpr (eventInfoOpt: EventInfo option, g, amap, delegateTy, delInvokeMeth: MethInfo, delArgTys, delFuncExpr, delFuncTy, m) =
@@ -1447,7 +1447,7 @@ let rec GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g (calledArg: C
         | Some tref ->
             let ty = mkILNonGenericBoxedTy tref
             let mref = mkILCtorMethSpecForTy(ty, [g.ilg.typ_Object]).MethodRef
-            let expr = Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [g.obj_ty]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr)
+            let expr = Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [g.obj_ty_noNulls]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr)
             emptyPreBinder, expr
 
     | WrapperForIUnknown ->
@@ -1456,7 +1456,7 @@ let rec GetDefaultExpressionForCallerSideOptionalArg tcFieldInit g (calledArg: C
         | Some tref ->
             let ty = mkILNonGenericBoxedTy tref
             let mref = mkILCtorMethSpecForTy(ty, [g.ilg.typ_Object]).MethodRef
-            let expr = Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [g.obj_ty]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr)
+            let expr = Expr.Op (TOp.ILCall (false, false, false, true, NormalValUse, false, false, mref, [], [], [g.obj_ty_noNulls]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr)
             emptyPreBinder, expr
 
     | PassByRef (ty, dfltVal2) ->

src/Compiler/Checking/MethodOverrides.fs

@@ -897,7 +897,7 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv
 #endif
        Option.isNone tycon.GeneratedCompareToValues &&
        tycon.HasInterface g g.mk_IComparable_ty && 
-       not (tycon.HasOverride g "Equals" [g.obj_ty]) && 
+       not (tycon.HasOverride g "Equals" [g.obj_ty_ambivalent]) && 
        not tycon.IsFSharpInterfaceTycon
      then
         (* Warn when we're doing this for class types *)
@@ -916,7 +916,7 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv
         let tcaug = tycon.TypeContents
         let m = tycon.Range
         let hasExplicitObjectGetHashCode = tycon.HasOverride g "GetHashCode" []
-        let hasExplicitObjectEqualsOverride = tycon.HasOverride g "Equals" [g.obj_ty]
+        let hasExplicitObjectEqualsOverride = tycon.HasOverride g "Equals" [g.obj_ty_ambivalent]
 
         if (Option.isSome tycon.GeneratedHashAndEqualsWithComparerValues) && 
            (hasExplicitObjectGetHashCode || hasExplicitObjectEqualsOverride) then 

src/Compiler/Checking/NameResolution.fs

@@ -4017,7 +4017,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid =
                 match item with
                 | Item.RecdField info -> info.FieldType
                 | Item.AnonRecdField (_, tys, index, _) -> tys[index]
-                | _ -> g.obj_ty
+                | _ -> g.obj_ty_ambivalent
 
             idsBeforeField, (fieldId, item) :: (nestedFieldSearch [] fieldTy rest)
 

src/Compiler/Checking/QuotationTranslator.fs

@@ -1223,7 +1223,7 @@ and ConvILType cenv env m ty =
 and TryElimErasableTyconRef cenv m (tcref: TyconRef) =
     match tcref.TypeReprInfo with
     // Get the base type
-    | TProvidedTypeRepr info when info.IsErased -> Some (info.BaseTypeForErased (m, cenv.g.obj_ty))
+    | TProvidedTypeRepr info when info.IsErased -> Some (info.BaseTypeForErased (m, cenv.g.obj_ty_withNulls))
     | _ -> None
 #endif