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

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 =