Nullness feature :: New warning for functions insisting on a (WithNull) argument + typar equality fix (#16853)

Null-handling functions now have the option to raise a warning when they are called with a known-to-be-withoutNull argument.
That way, API authors (incl. Fsharp.Core) can help with cleaning code from superflous null checks.

While doing it, a strange error kept coming when using Option.ofObj and other functions with a (T | null) typar.
It turned out that nullness info had been striped from nullable typars on stripTyparEqnsAux calls in some occasions, leading to treating all typars as 'KnownWithoutNull' even when that was not true.

Author: T-Gro

src/Compiler/Checking/CheckExpressions.fs

@@ -5163,10 +5163,14 @@ and ConvSynPatToSynExpr synPat =
 /// Check a long identifier 'Case' or 'Case argsR' that has been resolved to an active pattern case
 and TcPatLongIdentActivePatternCase warnOnUpper (cenv: cenv) (env: TcEnv) vFlags patEnv ty (mLongId, item, apref, args, m) =
     let g = cenv.g
-
     let (TcPatLinearEnv(tpenv, names, takenNames)) = patEnv
     let (APElemRef (apinfo, vref, idx, isStructRetTy)) = apref
 
+    let cenv = 
+        match g.checkNullness,TryFindLocalizedFSharpStringAttribute g g.attrib_WarnOnWithoutNullArgumentAttribute vref.Attribs with
+        | true, (Some _ as warnMsg) -> {cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = warnMsg}
+        | _ -> cenv
+
     // Report information about the 'active recognizer' occurrence to IDE
     CallNameResolutionSink cenv.tcSink (mLongId, env.NameEnv, item, emptyTyparInst, ItemOccurence.Pattern, env.eAccessRights)
 
@@ -8428,22 +8432,27 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg
                     SynExpr.ComputationExpr (true, comp, m)
                 | _ -> synArg
 
-            let arg, tpenv =
+            let (arg, tpenv), cenv =
                 // treat left and right of '||' and '&&' as control flow, so for example
                 //     f expr1 && g expr2
                 // will have debug points on "f expr1" and "g expr2"
-                let env =
+                let env,cenv =
                     match leftExpr with
                     | ApplicableExpr(expr=Expr.Val (vref, _, _))
                     | ApplicableExpr(expr=Expr.App (Expr.Val (vref, _, _), _, _, [_], _))
                          when valRefEq g vref g.and_vref
                            || valRefEq g vref g.and2_vref 
                            || valRefEq g vref g.or_vref
                            || valRefEq g vref g.or2_vref ->
-                        { env with eIsControlFlow = true }
-                    | _ -> env
-
-                TcExprFlex2 cenv domainTy env false tpenv synArg
+                        { env with eIsControlFlow = true },cenv
+                    | ApplicableExpr(expr=Expr.Val (valRef=vref))
+                    | ApplicableExpr(expr=Expr.App (funcExpr=Expr.Val (valRef=vref))) ->
+                        match TryFindLocalizedFSharpStringAttribute g g.attrib_WarnOnWithoutNullArgumentAttribute vref.Attribs with
+                        | Some _ as msg -> env,{ cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = msg}  
+                        | None -> env,cenv                                                      
+                    | _ -> env,cenv
+
+                TcExprFlex2 cenv domainTy env false tpenv synArg, cenv
 
             let exprAndArg, resultTy = buildApp cenv leftExpr resultTy arg mExprAndArg
             TcDelayed cenv overallTy env tpenv mExprAndArg exprAndArg resultTy atomicFlag delayed

src/Compiler/Checking/ConstraintSolver.fs

@@ -268,6 +268,7 @@ type ConstraintSolverState =
       /// Checks to run after all inference is complete.
       PostInferenceChecksFinal: ResizeArray<unit -> unit>
 
+      WarnWhenUsingWithoutNullOnAWithNullTarget: string option
     }
 
     static member New(g, amap, infoReader, tcVal) = 
@@ -277,7 +278,8 @@ type ConstraintSolverState =
           InfoReader = infoReader
           TcVal = tcVal
           PostInferenceChecksPreDefaults = ResizeArray()
-          PostInferenceChecksFinal = ResizeArray() } 
+          PostInferenceChecksFinal = ResizeArray()
+          WarnWhenUsingWithoutNullOnAWithNullTarget = None } 
 
     member this.PushPostInferenceCheck (preDefaults, check) =
         if preDefaults then
@@ -1041,6 +1043,9 @@ and SolveNullnessEquiv (csenv: ConstraintSolverEnv) m2 (trace: OptionalTrace) ty
         | _, NullnessInfo.AmbivalentToNull -> CompleteD
         | NullnessInfo.WithNull, NullnessInfo.WithNull -> CompleteD
         | NullnessInfo.WithoutNull, NullnessInfo.WithoutNull -> CompleteD
+        // Warn for 'strict "must pass null"` APIs like Option.ofObj
+        | NullnessInfo.WithNull, NullnessInfo.WithoutNull when csenv.g.checkNullness && csenv.SolverState.WarnWhenUsingWithoutNullOnAWithNullTarget.IsSome -> 
+            WarnD(Error(FSComp.SR.tcPassingWithoutNullToANullableExpectingFunc (csenv.SolverState.WarnWhenUsingWithoutNullOnAWithNullTarget.Value),m2))    
         // Allow expected of WithNull and actual of WithoutNull
         // TODO NULLNESS:  this is not sound in contravariant cases etc. It is assuming covariance.
         | NullnessInfo.WithNull, NullnessInfo.WithoutNull -> CompleteD
@@ -1076,8 +1081,12 @@ and SolveNullnessSubsumesNullness (csenv: ConstraintSolverEnv) m2 (trace: Option
         | _, NullnessInfo.AmbivalentToNull -> CompleteD
         | NullnessInfo.WithNull, NullnessInfo.WithNull -> CompleteD
         | NullnessInfo.WithoutNull, NullnessInfo.WithoutNull -> CompleteD
+        // Warn for 'strict "must pass null"` APIs like Option.ofObj
+        | NullnessInfo.WithNull, NullnessInfo.WithoutNull when csenv.g.checkNullness && csenv.SolverState.WarnWhenUsingWithoutNullOnAWithNullTarget.IsSome -> 
+            WarnD(Error(FSComp.SR.tcPassingWithoutNullToANullableExpectingFunc (csenv.SolverState.WarnWhenUsingWithoutNullOnAWithNullTarget.Value),m2))
         // Allow target of WithNull and actual of WithoutNull
-        | NullnessInfo.WithNull, NullnessInfo.WithoutNull -> CompleteD
+        | 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 
@@ -3968,7 +3977,8 @@ let CreateCodegenState tcVal g amap =
       ExtraCxs = HashMultiMap(10, HashIdentity.Structural)
       InfoReader = InfoReader(g, amap)
       PostInferenceChecksPreDefaults = ResizeArray() 
-      PostInferenceChecksFinal = ResizeArray() }
+      PostInferenceChecksFinal = ResizeArray()
+      WarnWhenUsingWithoutNullOnAWithNullTarget = None}
 
 /// Determine if a codegen witness for a trait will require witness args to be available, e.g. in generic code
 let CodegenWitnessExprForTraitConstraintWillRequireWitnessArgs tcVal g amap m (traitInfo:TraitConstraintInfo) =
@@ -4063,7 +4073,8 @@ let IsApplicableMethApprox g amap m (minfo: MethInfo) availObjTy =
               ExtraCxs = HashMultiMap(10, HashIdentity.Structural)
               InfoReader = InfoReader(g, amap)
               PostInferenceChecksPreDefaults = ResizeArray() 
-              PostInferenceChecksFinal = ResizeArray() }
+              PostInferenceChecksFinal = ResizeArray()
+              WarnWhenUsingWithoutNullOnAWithNullTarget = None}
         let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g)
         let minst = FreshenMethInfo m minfo
         match minfo.GetObjArgTypes(amap, m, minst) with

src/Compiler/Checking/ConstraintSolver.fsi

@@ -188,8 +188,32 @@ exception ArgDoesNotMatchError of
 /// A function that denotes captured tcVal, Used in constraint solver and elsewhere to get appropriate expressions for a ValRef.
 type TcValF = ValRef -> ValUseFlag -> TType list -> range -> Expr * TType
 
-[<Sealed>]
 type ConstraintSolverState =
+    {
+        g: TcGlobals
+
+        amap: ImportMap
+
+        InfoReader: InfoReader
+
+        /// The function used to freshen values we encounter during trait constraint solving
+        TcVal: TcValF
+
+        /// This table stores all unsolved, ungeneralized trait constraints, indexed by free type variable.
+        /// That is, there will be one entry in this table for each free type variable in
+        /// each outstanding, unsolved, ungeneralized trait constraint. Constraints are removed from the table and resolved
+        /// each time a solution to an index variable is found.
+        mutable ExtraCxs: Internal.Utilities.Collections.HashMultiMap<Stamp, TraitConstraintInfo * range>
+
+        /// Checks to run after all inference is complete, but before defaults are applied and internal unknowns solved
+        PostInferenceChecksPreDefaults: ResizeArray<unit -> unit>
+
+        /// Checks to run after all inference is complete.
+        PostInferenceChecksFinal: ResizeArray<unit -> unit>
+
+        WarnWhenUsingWithoutNullOnAWithNullTarget: string option
+    }
+
     static member New: TcGlobals * ImportMap * InfoReader * TcValF -> ConstraintSolverState
 
     /// Add a post-inference check to run at the end of inference

src/Compiler/FSComp.txt

@@ -1526,6 +1526,12 @@ notAFunctionButMaybeDeclaration,"This value is not a function and cannot be appl
 #3261 reserved for ConstraintSolverNullnessWarningWithTypes
 #3261 reserved for ConstraintSolverNullnessWarningWithType
 #3261 reserved for ConstraintSolverNullnessWarning
+3262,tcPassingWithoutNullToANullableExpectingFunc,"Value known to be without null passed to a function meant for nullables: %s"
+tcPassingWithoutNullToOptionOfObj,"You can create 'Some value' directly instead of 'ofObj', or consider not using an option for this value."
+tcPassingWithoutNullToValueOptionOfObj,"You can create 'ValueSome value' directly instead of 'ofObj', or consider not using a voption for this value."
+tcPassingWithoutNullToNonNullAP,"You can remove this |Null|NonNull| pattern usage."
+tcPassingWithoutNullToNonNullQuickAP,"You can remove this |NonNullQuick| pattern usage."
+tcPassingWithoutNullTononNullFunction,"You can remove this `nonNull` assertion."
 3268,csNullNotNullConstraintInconsistent,"The constraints 'null' and 'not null' are inconsistent"
 3271,tcNullnessCheckingNotEnabled,"The 'nullness checking' language feature is not enabled. This use of a nullness checking construct will be ignored."
 csTypeHasNullAsTrueValue,"The type '%s' uses 'null' as a representation value but a non-null type is expected"

src/Compiler/TypedTree/TcGlobals.fs

@@ -1573,6 +1573,7 @@ type TcGlobals(
   member val attrib_MeasureableAttribute                   = mk_MFCore_attrib "MeasureAnnotatedAbbreviationAttribute"
   member val attrib_NoDynamicInvocationAttribute           = mk_MFCore_attrib "NoDynamicInvocationAttribute"
   member val attrib_NoCompilerInliningAttribute            = mk_MFCore_attrib "NoCompilerInliningAttribute"
+  member val attrib_WarnOnWithoutNullArgumentAttribute      = mk_MFCore_attrib "WarnOnWithoutNullArgumentAttribute"
   member val attrib_SecurityAttribute                      = tryFindSysAttrib "System.Security.Permissions.SecurityAttribute"
   member val attrib_SecurityCriticalAttribute              = findSysAttrib "System.Security.SecurityCriticalAttribute"
   member val attrib_SecuritySafeCriticalAttribute          = findSysAttrib "System.Security.SecuritySafeCriticalAttribute"

src/Compiler/TypedTree/TypedTreeBasics.fs

@@ -315,7 +315,7 @@ let rec stripTyparEqnsAux nullness0 canShortcut ty =
             addNullnessToTy nullness0 ty
     | TType_measure unt -> 
         TType_measure (stripUnitEqnsAux canShortcut unt)
-    | _ -> ty
+    | _ -> addNullnessToTy nullness0 ty
 
 let stripTyparEqns ty = stripTyparEqnsAux KnownWithoutNull false ty
 

src/Compiler/TypedTree/TypedTreeOps.fs

@@ -3496,6 +3496,19 @@ let TryFindFSharpStringAttribute g nm attrs =
     match TryFindFSharpAttribute g nm attrs with
     | Some(Attrib(_, _, [ AttribStringArg b ], _, _, _, _)) -> Some b
     | _ -> None
+
+let TryFindLocalizedFSharpStringAttribute g nm attrs = 
+    match TryFindFSharpAttribute g nm attrs with
+    | Some(Attrib(_, _, [ AttribStringArg b ], namedArgs, _, _, _)) -> 
+        match namedArgs with 
+        | ExtractAttribNamedArg "Localize" (AttribBoolArg true) -> 
+            #if PROTO
+            Some b
+            #else
+            FSComp.SR.GetTextOpt(b)
+            #endif
+        | _ -> Some b
+    | _ -> None
 
 let TryFindILAttribute (AttribInfo (atref, _)) attrs = 
     HasILAttribute atref attrs

src/Compiler/TypedTree/TypedTreeOps.fsi

@@ -2286,6 +2286,8 @@ val TryFindFSharpBoolAttributeAssumeFalse: TcGlobals -> BuiltinAttribInfo -> Att
 
 val TryFindFSharpStringAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> string option
 
+val TryFindLocalizedFSharpStringAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> string option
+
 val TryFindFSharpInt32Attribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> int32 option
 
 /// Try to find a specific attribute on a type definition, where the attribute accepts a string argument.

src/Compiler/Utilities/Activity.fs

@@ -60,16 +60,16 @@ module internal Activity =
         member this.RootId =
             let rec rootID (act: Activity) =
                 match act.Parent with
-                | NonNull parent -> rootID parent
-                | Null -> act.Id
+                | null -> act.Id
+                | parent -> rootID parent
 
             rootID this
 
         member this.Depth =
             let rec depth (act: Activity) acc =
                 match act.Parent with
-                | NonNull parent -> depth parent (acc + 1)
-                | Null -> acc
+                | null -> acc
+                | parent -> depth parent (acc + 1)
 
             depth this 0
 
@@ -79,8 +79,8 @@ module internal Activity =
         let activity = activitySource.CreateActivity(name, ActivityKind.Internal)
 
         match activity with
-        | Null -> activity
-        | NonNull activity ->
+        | null -> activity
+        | activity ->
             for key, value in tags do
                 activity.AddTag(key, value) |> ignore
 
@@ -90,7 +90,8 @@ module internal Activity =
 
     let addEvent name =
         match Activity.Current with
-        | NonNull activity when activity.Source = activitySource -> activity.AddEvent(ActivityEvent name) |> ignore
+        | null -> ()
+        | activity when activity.Source = activitySource -> activity.AddEvent(ActivityEvent name) |> ignore
         | _ -> ()
 
     module Profiling =