Feature nullness :: Bugfixes

.gitignore

@@ -128,3 +128,5 @@ tests/FSharp.Compiler.Service.Tests/FSharp.CompilerService.SurfaceArea.netstanda
 *.vsp
 /tests/AheadOfTime/Trimming/output.txt
 *.svclog
+micro.exe
+positive.exe

src/Compiler/AbstractIL/ilread.fs

@@ -931,8 +931,9 @@ let mkCacheInt32 lowMem _inbase _nm _sz =
         (fun f x -> f x)
     else
         let mutable cache: ConcurrentDictionary<int32, _> MaybeNull = null // TODO NULLNESS: this explicit annotation should not be needed
-        let mutable count = 0
 #if STATISTICS
+        let mutable count = 0
+
         addReport (fun oc ->
             if count <> 0 then
                 oc.WriteLine((_inbase + string count + " " + _nm + " cache hits"): string))
@@ -948,7 +949,9 @@ let mkCacheInt32 lowMem _inbase _nm _sz =
 
             match cache.TryGetValue idx with
             | true, res ->
+#if STATISTICS
                 count <- count + 1
+#endif
                 res
             | _ ->
                 let res = f idx
@@ -960,8 +963,9 @@ let mkCacheGeneric lowMem _inbase _nm _sz =
         (fun f x -> f x)
     else
         let mutable cache: ConcurrentDictionary<_, _> MaybeNull = null // TODO NULLNESS: this explicit annotation should not be needed
-        let mutable count = 0
 #if STATISTICS
+        let mutable count = 0
+
         addReport (fun oc ->
             if !count <> 0 then
                 oc.WriteLine((_inbase + string !count + " " + _nm + " cache hits"): string))
@@ -977,7 +981,9 @@ let mkCacheGeneric lowMem _inbase _nm _sz =
 
             match cache.TryGetValue idx with
             | true, v ->
+#if STATISTICS
                 count <- count + 1
+#endif
                 v
             | _ ->
                 let res = f idx

src/Compiler/Checking/CheckExpressions.fs

@@ -1040,6 +1040,7 @@ let TcAddNullnessToType (warn: bool) (cenv: cenv) (env: TcEnv) nullness innerTyC
 
             if not g.compilingFSharpCore || not (isTyparTy g innerTyC) then 
                 AddCxTypeDefnNotSupportsNull env.DisplayEnv cenv.css m NoTrace innerTyC
+                AddCxTypeIsReferenceType env.DisplayEnv cenv.css m NoTrace innerTyC
 
             if not g.compilingFSharpCore && isTyparTy g innerTyC then
                 // A typar might be later infered into a type not supporting `| null|, like tuple or anon.
@@ -5314,6 +5315,7 @@ and TcExprFlex (cenv: cenv) flex compat (desiredTy: TType) (env: TcEnv) tpenv (s
 
     if flex then
         let argTy = NewInferenceType g
+        (destTyparTy g argTy).SetSupportsNullFlex(true)
         if compat then
             (destTyparTy g argTy).SetIsCompatFlex(true)
 
@@ -9601,7 +9603,8 @@ and TcEventItemThen (cenv: cenv) overallTy env tpenv mItem mExprAndItem objDetai
     | None, false -> error (Error (FSComp.SR.tcEventIsNotStatic nm, mItem))
     | _ -> ()
 
-    let delTy = einfo.GetDelegateType(cenv.amap, mItem)
+    // The F# wrappers around events are null safe (impl is in FSharp.Core). Therefore, from an F# perspective, the type of the delegate can be considered Not Null.
+    let delTy = einfo.GetDelegateType(cenv.amap, mItem) |> replaceNullnessOfTy KnownWithoutNull 
     let (SigOfFunctionForDelegate(delInvokeMeth, delArgTys, _, _)) = GetSigOfFunctionForDelegate cenv.infoReader delTy mItem ad
     let objArgs = Option.toList (Option.map fst objDetails)
     MethInfoChecks g cenv.amap true None objArgs env.eAccessRights mItem delInvokeMeth

src/Compiler/Checking/ConstraintSolver.fs

@@ -308,6 +308,9 @@ type ConstraintSolverEnv =
       // Is this speculative, with a trace allowing undo, and trial method overload resolution 
       IsSpeculativeForMethodOverloading: bool
 
+      // Can this ignore the 'must support null' constraint, e.g. in a mutable assignment scenario
+      IsSupportsNullFlex: bool
+
       /// Indicates that when unifying ty1 = ty2, only type variables in ty1 may be solved. Constraints
       /// can't be added to type variables in ty2
       MatchingOnly: bool
@@ -344,6 +347,7 @@ let MakeConstraintSolverEnv contextInfo css m denv =
       EquivEnv = TypeEquivEnv.Empty 
       DisplayEnv = denv
       IsSpeculativeForMethodOverloading = false
+      IsSupportsNullFlex = false
       ExtraRigidTypars = emptyFreeTypars
     }
 
@@ -953,6 +957,13 @@ let rec SolveTyparEqualsTypePart1 (csenv: ConstraintSolverEnv) m2 (trace: Option
         // Record the solution before we solve the constraints, since 
         // We may need to make use of the equation when solving the constraints. 
         // Record a entry in the undo trace if one is provided 
+
+        //let ty1AllowsNull = r.Constraints |> List.exists (function | TyparConstraint.SupportsNull _ -> true | _ -> false )
+        //let tyAllowsNull() = TypeNullIsExtraValueNew csenv.g m2 ty
+        //if ty1AllowsNull && not (tyAllowsNull()) then
+        //     trace.Exec (fun () -> r.typar_solution <- Some (ty |> replaceNullnessOfTy csenv.g.knownWithNull)) (fun () -> r.typar_solution <- None)
+        //else
+        //    trace.Exec (fun () -> r.typar_solution <- Some ty) (fun () -> r.typar_solution <- None)
         trace.Exec (fun () -> r.typar_solution <- Some ty) (fun () -> r.typar_solution <- None)
     }  
 
@@ -1218,6 +1229,12 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr
     let sty1 = stripTyEqnsA csenv.g canShortcut ty1
     let sty2 = stripTyEqnsA csenv.g canShortcut ty2
 
+    let csenv = 
+        match ty1 with 
+        | TType.TType_var(r,_) when r.typar_flags.IsSupportsNullFlex -> 
+            { csenv with IsSupportsNullFlex = true}
+        | _ -> csenv
+
     match sty1, sty2 with
     // type vars inside forall-types may be alpha-equivalent 
     | TType_var (tp1, nullness1), TType_var (tp2, nullness2) when typarEq tp1 tp2 || (match aenv.EquivTypars.TryFind tp1 with | Some tpTy1 when typeEquiv g tpTy1 ty2 -> true | _ -> false) ->
@@ -1273,6 +1290,15 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr
         // Unifying 'T1? and 'T2? 
         | ValueSome NullnessInfo.WithNull, ValueSome NullnessInfo.WithNull ->
             SolveTyparEqualsType csenv ndeep m2 trace sty1 (replaceNullnessOfTy g.knownWithoutNull sty2)
+        | ValueSome NullnessInfo.WithoutNull, ValueSome NullnessInfo.WithoutNull when 
+            csenv.IsSupportsNullFlex && 
+            isAppTy g sty2 && 
+            tp1.Constraints |> List.exists (function TyparConstraint.SupportsNull _ -> true | _ -> false) ->
+                let tpNew = NewCompGenTypar(TyparKind.Type, TyparRigidity.Flexible, TyparStaticReq.None, TyparDynamicReq.No, false)               
+                trackErrors {                    
+                    do! SolveTypeEqualsType csenv ndeep m2 trace cxsln (TType_var(tpNew, g.knownWithoutNull)) sty2
+                    do! SolveTypeEqualsType csenv ndeep m2 trace cxsln ty1 (TType_var(tpNew, g.knownWithNull))
+                }
         // Unifying 'T1 % and 'T2 % 
         //| ValueSome NullnessInfo.AmbivalentToNull, ValueSome NullnessInfo.AmbivalentToNull ->
         //    SolveTyparEqualsType csenv ndeep m2 trace sty1 (replaceNullnessOfTy g.knownWithoutNull sty2) 
@@ -2354,6 +2380,10 @@ and EnforceConstraintConsistency (csenv: ConstraintSolverEnv) ndeep m2 trace ret
         | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsReferenceType _
         | TyparConstraint.IsReferenceType _, TyparConstraint.IsNonNullableStruct _   ->
             return! ErrorD (Error(FSComp.SR.csStructConstraintInconsistent(), m))
+
+        | TyparConstraint.SupportsNull _, TyparConstraint.NotSupportsNull _
+        | TyparConstraint.NotSupportsNull _, TyparConstraint.SupportsNull _   ->
+            return! ErrorD (Error(FSComp.SR.csNullNotNullConstraintInconsistent(), m))
 
         | TyparConstraint.IsUnmanaged _, TyparConstraint.IsReferenceType _
         | TyparConstraint.IsReferenceType _, TyparConstraint.IsUnmanaged _ ->
@@ -2534,16 +2564,18 @@ and SolveTypeUseSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
                 return! ErrorD (ConstraintSolverError(FSComp.SR.csNullableTypeDoesNotHaveNull(NicePrint.minimalStringOfType denv ty), m, m2))
             else
                 match tryDestTyparTy g ty with
-                | ValueSome tp ->
+                | ValueSome tp ->                    
                     let nullness = nullnessOfTy g ty
                     match nullness.TryEvaluate() with
                     // NULLNESS TODO: This rule means turning on checkNullness changes type inference results for the cases
                     // mentioned in the comment above. THat's OK but needs to be documented in the RFC.
                     | ValueNone when not g.checkNullness ->
-                        return! AddConstraint csenv ndeep m2 trace tp (TyparConstraint.SupportsNull m)
-                    | ValueSome NullnessInfo.WithoutNull ->
+                        return! AddConstraint csenv ndeep m2 trace tp (TyparConstraint.SupportsNull m)                    
+                    | ValueSome NullnessInfo.WithoutNull ->                      
                         return! AddConstraint csenv ndeep m2 trace tp (TyparConstraint.SupportsNull m)
                     | _ ->
+                        if tp.Constraints |> List.exists (function | TyparConstraint.IsReferenceType _ -> true | _ -> false) |> not then
+                            do! AddConstraint csenv ndeep m2 trace tp (TyparConstraint.IsReferenceType m)
                         return! SolveNullnessSupportsNull csenv ndeep m2 trace ty nullness
                 | _ ->
                     let nullness = nullnessOfTy g ty
@@ -2580,9 +2612,10 @@ and SolveNullnessSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 (trace: Opti
             match n1 with 
             | NullnessInfo.AmbivalentToNull -> ()
             | NullnessInfo.WithNull -> ()
-            | NullnessInfo.WithoutNull -> 
+            | NullnessInfo.WithoutNull ->   
                 if g.checkNullness then 
-                    return! WarnD(ConstraintSolverNullnessWarningWithType(denv, ty, n1, m, m2)) 
+                    // TODO nullness: Shouldn't this be an error? We have a 'must support null' situation which is not being met.
+                    return! WarnD(ConstraintSolverNullnessWarningWithType(denv, ty, n1, m, m2))
     }
 
 and SolveTypeUseNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
@@ -2635,7 +2668,9 @@ and SolveTypeCanCarryNullness (csenv: ConstraintSolverEnv)  ty nullness =
         let m = csenv.m
         let strippedTy = stripTyEqnsA g true ty
         match tryAddNullnessToTy nullness strippedTy with
-        | Some _ -> ()
+        | Some _ -> 
+            if isTyparTy g strippedTy && not (isReferenceTyparTy g strippedTy) then
+                return! AddConstraint csenv 0 m NoTrace (destTyparTy g strippedTy) (TyparConstraint.IsReferenceType m)
         | None -> 
             let tyString = NicePrint.minimalStringOfType csenv.DisplayEnv strippedTy
             return! ErrorD(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m))

src/Compiler/CodeGen/IlxGen.fs

@@ -5648,17 +5648,23 @@ and GenGenericParam cenv eenv (tp: Typar) =
             | TyparConstraint.IsNonNullableStruct _ -> true
             | _ -> false)
 
-    let notNullReferenceTypeConstraint =
+    let nullnessOfTypar =
         if g.langFeatureNullness && g.checkNullness then
             let hasNotSupportsNull =
                 tp.Constraints
                 |> List.exists (function
                     | TyparConstraint.NotSupportsNull _ -> true
                     | _ -> false)
 
+            let hasSupportsNull () =
+                tp.Constraints
+                |> List.exists (function
+                    | TyparConstraint.SupportsNull _ -> true
+                    | _ -> false)
+
             if hasNotSupportsNull || notNullableValueTypeConstraint then
                 NullnessInfo.WithoutNull
-            elif hasNotSupportsNull || refTypeConstraint then
+            elif refTypeConstraint || hasSupportsNull () then
                 NullnessInfo.WithNull
             else
                 NullnessInfo.AmbivalentToNull
@@ -5711,7 +5717,7 @@ and GenGenericParam cenv eenv (tp: Typar) =
             yield! GenAttrs cenv eenv tp.Attribs
             if emitUnmanagedInIlOutput then
                 yield (GetIsUnmanagedAttribute g)
-            match notNullReferenceTypeConstraint with
+            match nullnessOfTypar with
             | Some nullInfo -> yield GetNullableAttribute g [ nullInfo ]
             | _ -> ()
         ]

src/Compiler/CodeGen/IlxGenSupport.fs

@@ -446,8 +446,8 @@ let rec GetNullnessFromTType (g: TcGlobals) ty =
         ]
     | TType_forall _
     | TType_ucase _
-    | TType_var _
     | TType_measure _ -> []
+    | TType_var(nullness = nullness) -> [ nullness.Evaluate() ]
 
 let GenNullnessIfNecessary (g: TcGlobals) ty =
     if g.langFeatureNullness && g.checkNullness then

src/Compiler/TypedTree/TypedTree.fs

@@ -300,7 +300,7 @@ type TyparRigidity =
 [<Struct>]
 type TyparFlags(flags: int32) =
 
-    new (kind: TyparKind, rigidity: TyparRigidity, isFromError: bool, isCompGen: bool, staticReq: TyparStaticReq, dynamicReq: TyparDynamicReq, equalityDependsOn: bool, comparisonDependsOn: bool) = 
+    new (kind: TyparKind, rigidity: TyparRigidity, isFromError: bool, isCompGen: bool, staticReq: TyparStaticReq, dynamicReq: TyparDynamicReq, equalityDependsOn: bool, comparisonDependsOn: bool, supportsNullFlex: bool) = 
         TyparFlags((if isFromError then                0b00000000000000010 else 0) |||
                    (if isCompGen   then                0b00000000000000100 else 0) |||
                    (match staticReq with
@@ -321,7 +321,11 @@ type TyparFlags(flags: int32) =
                      | TyparDynamicReq.No           -> 0b00000000000000000
                      | TyparDynamicReq.Yes          -> 0b00000010000000000) |||
                    (if equalityDependsOn then 
-                                                       0b00000100000000000 else 0))
+                                                       0b00000100000000000 else 0) |||
+                                                  //   0b00001000100000000 is being checked by x.Kind, but never set in this version of the code
+                                                  //   0b00010000000000000 is taken by compat flex
+                   (if supportsNullFlex then
+                                                       0b00100000000000000 else 0))
 
     /// Indicates if the type inference variable was generated after an error when type checking expressions or patterns
     member x.IsFromError         = (flags &&& 0b00000000000000010) <> 0x0
@@ -380,8 +384,20 @@ type TyparFlags(flags: int32) =
                   else
                       TyparFlags(flags &&& ~~~0b00010000000000000)
 
+    /// Indicates that whether this type parameter is flexible for 'supports null' constraint, e.g. in the case of assignment to a mutable value
+    member x.IsSupportsNullFlex = 
+                                   (flags &&& 0b00100000000000000) <> 0x0
+
+    member x.WithSupportsNullFlex b = 
+                  if b then 
+                      TyparFlags(flags |||    0b00100000000000000)
+                  else
+                      TyparFlags(flags &&& ~~~0b00100000000000000)
+
+
+
     member x.WithStaticReq staticReq =  
-        TyparFlags(x.Kind, x.Rigidity, x.IsFromError, x.IsCompilerGenerated, staticReq, x.DynamicReq, x.EqualityConditionalOn, x.ComparisonConditionalOn) 
+        TyparFlags(x.Kind, x.Rigidity, x.IsFromError, x.IsCompilerGenerated, staticReq, x.DynamicReq, x.EqualityConditionalOn, x.ComparisonConditionalOn, x.IsSupportsNullFlex) 
 
     /// Get the flags as included in the F# binary metadata. We pickle this as int64 to allow for future expansion
     member x.PickledBits = flags       
@@ -2321,6 +2337,8 @@ type Typar =
     /// Set whether this type parameter is a compat-flex type parameter (i.e. where "expr :> tp" only emits an optional warning)
     member x.SetIsCompatFlex b = x.typar_flags <- x.typar_flags.WithCompatFlex b
 
+     member x.SetSupportsNullFlex b = x.typar_flags <- x.typar_flags.WithSupportsNullFlex b
+
     /// Indicates whether a type variable can be instantiated by types or units-of-measure.
     member x.Kind = x.typar_flags.Kind
 
@@ -2425,12 +2443,12 @@ type Typar =
     /// Sets the rigidity of a type variable
     member x.SetRigidity b =
         let flags = x.typar_flags
-        x.typar_flags <- TyparFlags(flags.Kind, b, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) 
+        x.typar_flags <- TyparFlags(flags.Kind, b, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn, flags.IsSupportsNullFlex) 
 
     /// Sets whether a type variable is compiler generated
     member x.SetCompilerGenerated b =
         let flags = x.typar_flags
-        x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, b, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) 
+        x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, b, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn, flags.IsSupportsNullFlex) 
 
     /// Sets whether a type variable has a static requirement
     member x.SetStaticReq b =
@@ -2439,17 +2457,17 @@ type Typar =
     /// Sets whether a type variable is required at runtime
     member x.SetDynamicReq b =
         let flags = x.typar_flags
-        x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, b, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) 
+        x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, b, flags.EqualityConditionalOn, flags.ComparisonConditionalOn, flags.IsSupportsNullFlex) 
 
     /// Sets whether the equality constraint of a type definition depends on this type variable 
     member x.SetEqualityDependsOn b =
         let flags = x.typar_flags
-        x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, b, flags.ComparisonConditionalOn) 
+        x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, b, flags.ComparisonConditionalOn, flags.IsSupportsNullFlex) 
 
     /// Sets whether the comparison constraint of a type definition depends on this type variable 
     member x.SetComparisonDependsOn b =
         let flags = x.typar_flags
-        x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, b) 
+        x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, b, flags.IsSupportsNullFlex) 
 
     [<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
     member x.DebugText = x.ToString()
@@ -6118,7 +6136,7 @@ type Construct() =
         Typar.New
           { typar_id = id 
             typar_stamp = newStamp() 
-            typar_flags= TyparFlags(kind, rigid, isFromError, isCompGen, staticReq, dynamicReq, eqDep, compDep) 
+            typar_flags= TyparFlags(kind, rigid, isFromError, isCompGen, staticReq, dynamicReq, eqDep, compDep, false) 
             typar_solution = None
             typar_astype = Unchecked.defaultof<_>
             typar_opt_data =