Feature nullness - propper guards against | null on unsupported types

docs/release-notes/.FSharp.Compiler.Service/8.0.300.md

@@ -23,13 +23,14 @@
 * Enforce AttributeTargets on implicit constructors. ([PR #16845](https://github.com/dotnet/fsharp/pull/16845/))
 * Enforce AttributeTargets on structs and classes ([PR #16790](https://github.com/dotnet/fsharp/pull/16790))
 * Parser: fix pattern range for idents with trivia ([PR #16824](https://github.com/dotnet/fsharp/pull/16824))
-* Fix broken code completion after a record type declaration ([PR #16813](https://github.com/dotnet/fsharp/pull/16813))
+* Fix broken code completion after a record type declaration ([PR #16813](https://github.com/dotnet/fsharp/pull/16813))* Enforce AttributeTargets on enums ([PR #16887](https://github.com/dotnet/fsharp/pull/16887))
 * Enforce AttributeTargets on enums ([PR #16887](https://github.com/dotnet/fsharp/pull/16887))
 * Completion: fix for unfinished record field decl ([PR #16893](https://github.com/dotnet/fsharp/pull/16893))
 * Enforce AttributeTargets on delegates ([PR #16891](https://github.com/dotnet/fsharp/pull/16891))
 * Completion: fix completion in empty dot lambda prefix ([#16829](https://github.com/dotnet/fsharp/pull/16829))
 * Fix StackOverflow when checking non-recursive bindings in module or namespace in `fscAnyCpu`/`fsiAnyCpu`. ([PR #16908](https://github.com/dotnet/fsharp/pull/16908))
 
+
 ### Added
 
 * Support for nullable reference types ([PR #15181](https://github.com/dotnet/fsharp/pull/15181))

docs/release-notes/.FSharp.Core/8.0.300.md

@@ -11,3 +11,4 @@
 * Enforce AttributeTargets on structs and classes. Also update `RequireQualifiedAccessAttribute` and `AutoOpenAttribute` to use `AttributeTargets.Struct` ([PR #16790](https://github.com/dotnet/fsharp/pull/16790))
 * Enforce AttributeTargets on enums. Also update `RequireQualifiedAccessAttribute` to use `AttributeTargets.Enum` ([PR #16887](https://github.com/dotnet/fsharp/pull/16887))
 * Enforce AttributeTargets on delegates. Also update `ReflectedDefinitionAttribute` to use `AttributeTargets.Delegate` ([PR #16891](https://github.com/dotnet/fsharp/pull/16891))
+

src/Compiler/Checking/AttributeChecking.fs

@@ -540,7 +540,7 @@ let IsSecurityAttribute (g: TcGlobals) amap (casmap : IDictionary<Stamp, bool>)
             match casmap.TryGetValue tcs with
             | true, c -> c
             | _ ->
-                let exists = ExistsInEntireHierarchyOfType (fun t -> typeEquiv g t (mkAppTy attr.TyconRef [])) g amap m AllowMultiIntfInstantiations.Yes (mkAppTy tcref [])          
+                let exists = ExistsInEntireHierarchyOfType (fun t -> typeEquiv g t (mkWoNullAppTy attr.TyconRef [])) g amap m AllowMultiIntfInstantiations.Yes (mkWoNullAppTy tcref [])          
                 casmap[tcs] <- exists
                 exists
         | ValueNone -> false  

src/Compiler/Checking/AugmentWithHashCompare.fs

@@ -20,7 +20,7 @@ let mkIComparableCompareToSlotSig (g: TcGlobals) =
 let mkGenericIComparableCompareToSlotSig (g: TcGlobals) ty =
     TSlotSig(
         "CompareTo",
-        (mkAppTy g.system_GenericIComparable_tcref [ ty ]),
+        (mkWoNullAppTy g.system_GenericIComparable_tcref [ ty ]),
         [],
         [],
         [ [ TSlotParam(Some("obj"), ty, false, false, false, []) ] ],
@@ -44,7 +44,7 @@ let mkIStructuralComparableCompareToSlotSig (g: TcGlobals) =
 let mkGenericIEquatableEqualsSlotSig (g: TcGlobals) ty =
     TSlotSig(
         "Equals",
-        (mkAppTy g.system_GenericIEquatable_tcref [ ty ]),
+        (mkWoNullAppTy g.system_GenericIEquatable_tcref [ ty ]),
         [],
         [],
         [ [ TSlotParam(Some("obj"), ty, false, false, false, []) ] ],
@@ -414,7 +414,7 @@ let mkExnEquality (g: TcGlobals) exnref (exnc: Tycon) =
 
         let cases =
             [
-                mkCase (DecisionTreeTest.IsInst(g.exn_ty, mkAppTy exnref []), mbuilder.AddResultTarget(expr))
+                mkCase (DecisionTreeTest.IsInst(g.exn_ty, mkWoNullAppTy exnref []), mbuilder.AddResultTarget(expr))
             ]
 
         let dflt = Some(mbuilder.AddResultTarget(mkFalse g m))
@@ -445,7 +445,7 @@ let mkExnEqualityWithComparer g exnref (exnc: Tycon) (_thisv, thise) thatobje (t
 
         let cases =
             [
-                mkCase (DecisionTreeTest.IsInst(g.exn_ty, mkAppTy exnref []), mbuilder.AddResultTarget(expr))
+                mkCase (DecisionTreeTest.IsInst(g.exn_ty, mkWoNullAppTy exnref []), mbuilder.AddResultTarget(expr))
             ]
 
         let dflt = mbuilder.AddResultTarget(mkFalse g m)

src/Compiler/Checking/CheckDeclarations.fs

@@ -776,7 +776,7 @@ module AddAugmentationDeclarations =
             let tcaug = tycon.TypeContents
             let ty = if tcref.Deref.IsFSharpException then g.exn_ty else generalizedTyconRef g tcref
             let m = tycon.Range
-            let genericIComparableTy = mkAppTy g.system_GenericIComparable_tcref [ty]
+            let genericIComparableTy = mkWoNullAppTy g.system_GenericIComparable_tcref [ty]
 
 
             let hasExplicitIComparable = tycon.HasInterface g g.mk_IComparable_ty 
@@ -874,7 +874,7 @@ module AddAugmentationDeclarations =
                  let vspec1, vspec2 = AugmentTypeDefinitions.MakeValsForEqualsAugmentation g tcref
                  tcaug.SetEquals (mkLocalValRef vspec1, mkLocalValRef vspec2)
                  if not tycon.IsFSharpException then 
-                    PublishInterface cenv env.DisplayEnv tcref m true (mkAppTy g.system_GenericIEquatable_tcref [ty])
+                    PublishInterface cenv env.DisplayEnv tcref m true (mkWoNullAppTy g.system_GenericIEquatable_tcref [ty])
                  PublishValueDefn cenv env ModuleOrMemberBinding vspec1
                  PublishValueDefn cenv env ModuleOrMemberBinding vspec2
                  AugmentTypeDefinitions.MakeBindingsForEqualsAugmentation g tycon
@@ -1992,8 +1992,8 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (env
 
                   if (generatedCompareToValues && typeEquiv g intfTyR g.mk_IComparable_ty) || 
                       (generatedCompareToWithComparerValues && typeEquiv g intfTyR g.mk_IStructuralComparable_ty) ||
-                      (generatedCompareToValues && typeEquiv g intfTyR (mkAppTy g.system_GenericIComparable_tcref [ty])) ||
-                      (generatedHashAndEqualsWithComparerValues && typeEquiv g intfTyR (mkAppTy g.system_GenericIEquatable_tcref [ty])) ||
+                      (generatedCompareToValues && typeEquiv g intfTyR (mkWoNullAppTy g.system_GenericIComparable_tcref [ty])) ||
+                      (generatedHashAndEqualsWithComparerValues && typeEquiv g intfTyR (mkWoNullAppTy g.system_GenericIEquatable_tcref [ty])) ||
                       (generatedHashAndEqualsWithComparerValues && typeEquiv g intfTyR g.mk_IStructuralEquatable_ty) then
                       errorR(Error(FSComp.SR.tcDefaultImplementationForInterfaceHasAlreadyBeenAdded(), intfTy.Range))
 
@@ -3328,7 +3328,7 @@ module EstablishTypeDefinitionCores =
                   super |> Option.map (fun ty -> 
                      if isFunTy g ty then  
                          let a,b = destFunTy g ty
-                         mkAppTy g.fastFunc_tcr [a; b] 
+                         mkWoNullAppTy g.fastFunc_tcr [a; b] 
                      else ty)
 
               // Publish the super type
@@ -3727,7 +3727,7 @@ module EstablishTypeDefinitionCores =
             // validate ConditionalAttribute, should it be applied (it's only valid on a type if the type is an attribute type)
             match attrs |> List.tryFind (IsMatchingFSharpAttribute g g.attrib_ConditionalAttribute) with
             | Some _ ->
-                if not(ExistsInEntireHierarchyOfType (fun t -> typeEquiv g t (mkAppTy g.tcref_System_Attribute [])) g cenv.amap m AllowMultiIntfInstantiations.Yes thisTy) then
+                if not(ExistsInEntireHierarchyOfType (fun t -> typeEquiv g t (mkWoNullAppTy g.tcref_System_Attribute [])) g cenv.amap m AllowMultiIntfInstantiations.Yes thisTy) then
                     errorR(Error(FSComp.SR.tcConditionalAttributeUsage(), m))
             | _ -> ()         
 

src/Compiler/Checking/CheckExpressions.fs

@@ -830,10 +830,10 @@ let TcConst (cenv: cenv) (overallTy: TType) m env synConst =
         let measureTy =
             match synConst with
             | SynConst.Measure(synMeasure = SynMeasure.Anon _) ->
-              (mkAppTy tcr [TType_measure (Measure.Var (NewAnonTypar (TyparKind.Measure, m, TyparRigidity.Anon, (if iszero then TyparStaticReq.None else TyparStaticReq.HeadType), TyparDynamicReq.No)))])
+              (mkWoNullAppTy tcr [TType_measure (Measure.Var (NewAnonTypar (TyparKind.Measure, m, TyparRigidity.Anon, (if iszero then TyparStaticReq.None else TyparStaticReq.HeadType), TyparDynamicReq.No)))])
 
-            | SynConst.Measure(synMeasure = ms) -> mkAppTy tcr [TType_measure (tcMeasure ms)]
-            | _ -> mkAppTy tcr [TType_measure Measure.One]
+            | SynConst.Measure(synMeasure = ms) -> mkWoNullAppTy tcr [TType_measure (tcMeasure ms)]
+            | _ -> mkWoNullAppTy tcr [TType_measure Measure.One]
         unif measureTy
 
     let expandedMeasurablesEnabled =
@@ -853,7 +853,7 @@ let TcConst (cenv: cenv) (overallTy: TType) m env synConst =
         unif g.float_ty
         Const.Double f
     | SynConst.Decimal f ->
-        unif (mkAppTy g.decimal_tcr [])
+        unif (mkWoNullAppTy g.decimal_tcr [])
         Const.Decimal f
     | SynConst.SByte i ->
         unif g.sbyte_ty
@@ -1041,6 +1041,11 @@ 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
 
+            if not g.compilingFSharpCore && isTyparTy g innerTyC then
+                // A typar might be later infered into a type not supporting `| null|, like tuple or anon.
+                // Repeat the check in post inference
+                AddCxTypeCanCarryNullnessInfo env.DisplayEnv cenv.css m innerTyC nullness
+
             innerTyCWithNull
 
     else
@@ -3419,7 +3424,7 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr
     match probe exprTyAsSeq with
     | Some res -> res
     | None ->
-    let ienumerable = mkAppTy g.tcref_System_Collections_IEnumerable []
+    let ienumerable = mkWoNullAppTy g.tcref_System_Collections_IEnumerable []
     match probe ienumerable with
     | Some res -> res
     | None ->
@@ -5025,7 +5030,7 @@ and TcProvidedTypeApp (cenv: cenv) env tpenv tcref args m =
     // We put the type name check after the 'isDirectReferenceToGenerated' check because we need the 'isDirectReferenceToGenerated' error to be shown for generated types
     checkTypeName()
     if hasNoArgs then
-        mkAppTy tcref [], tpenv
+        mkWoNullAppTy tcref [], tpenv
     else
         let ty = Import.ImportProvidedType cenv.amap m providedTypeAfterStaticArguments
         ty, tpenv
@@ -7646,7 +7651,7 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, m
                 | None -> []
                 | Some(tinst, tcref, _, fldsList) ->
 
-                let gtyp = mkAppTy tcref tinst
+                let gtyp = mkWoNullAppTy tcref tinst
                 UnifyTypes cenv env mWholeExpr overallTy gtyp
 
                 [ for n, v in fldsList do
@@ -12114,7 +12119,7 @@ and TcLetrecBinding
             | None ->
                 let reqdThisValTy = if isByrefTy g reqdThisValTy then destByrefTy g reqdThisValTy else reqdThisValTy
                 let enclosingTyconRef = tcrefOfAppTy g reqdThisValTy
-                reqdThisValTy, (mkAppTy enclosingTyconRef (List.map mkTyparTy enclosingDeclaredTypars)), vspec.Range
+                reqdThisValTy, (mkWoNullAppTy enclosingTyconRef (List.map mkTyparTy enclosingDeclaredTypars)), vspec.Range
             | Some thisVal ->
                 reqdThisValTy, thisVal.Type, thisVal.Range
         if not (AddCxTypeEqualsTypeUndoIfFailed envRec.DisplayEnv cenv.css rangeForCheck actualThisValTy reqdThisValTy) then

src/Compiler/Checking/CheckPatterns.fs

@@ -446,7 +446,7 @@ and TcRecordPat warnOnUpper cenv env vFlags patEnv ty fieldPats m =
     | None -> (fun _ -> TPat_error m), patEnv
     | Some(tinst, tcref, fldsmap, _fldsList) ->
 
-    let gtyp = mkAppTy tcref tinst
+    let gtyp = mkWoNullAppTy tcref tinst
     let inst = List.zip (tcref.Typars m) tinst
 
     UnifyTypes cenv env m ty gtyp

src/Compiler/Checking/ConstraintSolver.fs

@@ -1545,7 +1545,7 @@ and DepthCheck ndeep m =
 and SolveDimensionlessNumericType (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
     match getMeasureOfType csenv.g ty with
     | Some (tcref, _) -> 
-        SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty (mkAppTy tcref [TType_measure Measure.One])
+        SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty (mkWoNullAppTy tcref [TType_measure Measure.One])
     | None ->
         CompleteD
 
@@ -1650,17 +1650,17 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
                     match getMeasureOfType g argTy1 with
                     | Some (tcref, ms1) ->
                         let ms2 = freshMeasure ()
-                        do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 (mkAppTy tcref [TType_measure ms2])
-                        do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))])
+                        do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 (mkWoNullAppTy tcref [TType_measure ms2])
+                        do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))])
                         return TTraitBuiltIn
 
                     | _ ->
 
                         match getMeasureOfType g argTy2 with
                         | Some (tcref, ms2) ->
                             let ms1 = freshMeasure ()
-                            do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkAppTy tcref [TType_measure ms1]) 
-                            do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))])
+                            do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkWoNullAppTy tcref [TType_measure ms1]) 
+                            do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))])
                             return TTraitBuiltIn
 
                         | _ ->
@@ -1794,8 +1794,8 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
                     match getMeasureOfType g argTy1 with
                         | Some (tcref, _) -> 
                             let ms1 = freshMeasure () 
-                            do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkAppTy tcref [TType_measure (Measure.Prod (ms1, ms1))])
-                            do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkAppTy tcref [TType_measure ms1])
+                            do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkWoNullAppTy tcref [TType_measure (Measure.Prod (ms1, ms1))])
+                            do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure ms1])
                             return TTraitBuiltIn
                         | None -> 
                             do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1
@@ -1847,7 +1847,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
                     do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1
                     match getMeasureOfType g argTy1 with
                     | None -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1
-                    | Some (tcref, _) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkAppTy tcref [TType_measure Measure.One])
+                    | Some (tcref, _) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure Measure.One])
                     return TTraitBuiltIn
 
                 | _ -> 
@@ -2623,6 +2623,18 @@ and SolveNullnessNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 (trace: O
                     return! WarnD(ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalStringOfType denv ty), m, m2))
     }
 
+and SolveTypeCanCarryNullness (csenv: ConstraintSolverEnv)  ty nullness =
+    trackErrors {
+        let g = csenv.g
+        let m = csenv.m
+        let strippedTy = stripTyEqnsA g true ty
+        match tryAddNullnessToTy nullness strippedTy with
+        | Some _ -> ()
+        | None -> 
+            let tyString = NicePrint.minimalStringOfType csenv.DisplayEnv strippedTy
+            return! ErrorD(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m))
+    }
+
 and SolveTypeSupportsComparison (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
     let g = csenv.g
     let m = csenv.m
@@ -3885,6 +3897,12 @@ let AddCxTypeUseSupportsNull denv css m trace ty =
         (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m)))
     |> RaiseOperationResult
 
+let AddCxTypeCanCarryNullnessInfo denv css m ty nullness =
+    let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv
+    let canCarryNullnessCheck() = SolveTypeCanCarryNullness csenv ty nullness |> RaiseOperationResult
+    csenv.SolverState.PushPostInferenceCheck (preDefaults=false, check = canCarryNullnessCheck)
+
+
 let AddCxTypeMustSupportComparison denv css m trace ty =
     let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv
     PostponeOnFailedMemberConstraintResolution csenv trace

src/Compiler/Checking/ConstraintSolver.fsi

@@ -291,6 +291,8 @@ val AddCxTypeDefnNotSupportsNull: DisplayEnv -> ConstraintSolverState -> range -
 
 val AddCxTypeUseSupportsNull: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
 
+val AddCxTypeCanCarryNullnessInfo: DisplayEnv -> ConstraintSolverState -> range -> TType -> Nullness -> unit
+
 val AddCxTypeMustSupportComparison: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
 
 val AddCxTypeMustSupportEquality: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit

src/Compiler/Checking/NameResolution.fs

@@ -1107,7 +1107,7 @@ let GetNestedTyconRefsOfType (infoReader: InfoReader) (amap: Import.ImportMap) (
 let MakeNestedType (ncenv: NameResolver) (tinst: TType list) m (tcrefNested: TyconRef) =
     let tps = match tcrefNested.Typars m with [] -> [] | l -> List.skip tinst.Length l
     let tinstNested = ncenv.InstantiationGenerator m tps
-    mkAppTy tcrefNested (tinst @ tinstNested)
+    mkWoNullAppTy tcrefNested (tinst @ tinstNested)
 
 /// Get all the accessible nested types of an existing type.
 let GetNestedTypesOfType (ad, ncenv: NameResolver, optFilter, staticResInfo, checkForGenerated, m) ty =
@@ -3400,7 +3400,7 @@ let rec ResolvePatternLongIdentPrim sink (ncenv: NameResolver) fullyQualified wa
                     | tcref :: _ when tcref.IsUnionTycon ->
                         let res = ResolutionInfo.Empty.AddEntity (id.idRange, tcref)
                         ResolutionInfo.SendEntityPathToSink (sink, ncenv, nenv, ItemOccurence.Pattern, ad, res, ResultTyparChecker(fun () -> true))
-                        Item.Types (id.idText, [ mkAppTy tcref [] ])
+                        Item.Types (id.idText, [ mkWoNullAppTy tcref [] ])
                     | _ ->
                         match ResolveLongIdentAsModuleOrNamespace sink ncenv.amap id.idRange true fullyQualified nenv ad id [] false ShouldNotifySink.Yes with
                         | Result ((_, mref, _) :: _) ->