Nullness - downcasting and typetests should understand nullness infor…

…mation (#17965)

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

@@ -9,6 +9,7 @@
 * Fix concurrency issue in `ILPreTypeDefImpl`  ([PR #17812](https://github.com/dotnet/fsharp/pull/17812))
 * Fix nullness inference for member val and other OO scenarios  ([PR #17845](https://github.com/dotnet/fsharp/pull/17845))
 * Fix internal error when analyzing incomplete inherit member ([PR #17905](https://github.com/dotnet/fsharp/pull/17905))
+* Add warning when downcasting from nullable type to non-nullable ([PR #17965](https://github.com/dotnet/fsharp/pull/17965))
 * Fix missing nullness warning in case of method resolution multiple candidates ([PR #17917](https://github.com/dotnet/fsharp/pull/17918))
 * Fix failure to use bound values in `when` clauses of `try-with` in `seq` expressions ([# 17990](https://github.com/dotnet/fsharp/pull/17990))
 

src/Compiler/AbstractIL/il.fs

@@ -481,11 +481,11 @@ type ILAssemblyRef(data) =
     override x.GetHashCode() = uniqueStamp
 
     override x.Equals yobj =
-        ((yobj :?> ILAssemblyRef).UniqueStamp = uniqueStamp)
+        ((!!yobj :?> ILAssemblyRef).UniqueStamp = uniqueStamp)
 
     interface IComparable with
         override x.CompareTo yobj =
-            compare (yobj :?> ILAssemblyRef).UniqueStamp uniqueStamp
+            compare (!!yobj :?> ILAssemblyRef).UniqueStamp uniqueStamp
 
     static member Create(name, hash, publicKey, retargetable, version, locale) =
         ILAssemblyRef
@@ -750,7 +750,7 @@ type ILTypeRef =
     override x.GetHashCode() = x.hashCode
 
     override x.Equals yobj =
-        let y = (yobj :?> ILTypeRef)
+        let y = (!!yobj :?> ILTypeRef)
 
         (x.ApproxId = y.ApproxId)
         && (x.Scope = y.Scope)
@@ -793,7 +793,7 @@ type ILTypeRef =
     interface IComparable with
 
         override x.CompareTo yobj =
-            let y = (yobj :?> ILTypeRef)
+            let y = (!!yobj :?> ILTypeRef)
             let c = compare x.ApproxId y.ApproxId
 
             if c <> 0 then

src/Compiler/AbstractIL/ilreflect.fs

@@ -1834,7 +1834,7 @@ let rec buildMethodPass2 cenv tref (typB: TypeBuilder) emEnv (mdef: ILMethodDef)
         let methB =
             System.Diagnostics.Debug.Assert(not (isNull definePInvokeMethod), "Runtime does not have DefinePInvokeMethod") // Absolutely can't happen
 
-            (!!definePInvokeMethod)
+            !!(!!definePInvokeMethod)
                 .Invoke(
                     typB,
                     [|

src/Compiler/Checking/ConstraintSolver.fs

@@ -2681,8 +2681,7 @@ and SolveTypeUseNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
             do! WarnD (ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsTrueValue(NicePrint.minimalStringOfType denv ty), m, m2))
         elif TypeNullIsExtraValueNew g m 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))
+                do! WarnD (ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalStringOfTypeWithNullness denv ty), m, m2))
         else
             match tryDestTyparTy g ty with
             | ValueSome tp ->
@@ -2709,8 +2708,7 @@ and SolveNullnessNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 (trace: O
             | NullnessInfo.WithoutNull -> ()
             | NullnessInfo.WithNull -> 
                 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))
+                    return! WarnD(ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalStringOfTypeWithNullness denv ty), m, m2))
     }
 
 and SolveTypeCanCarryNullness (csenv: ConstraintSolverEnv)  ty nullness =

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -2984,11 +2984,20 @@ let TcRuntimeTypeTest isCast isOperator (cenv: cenv) denv m tgtTy srcTy =
         else
             error(Error(FSComp.SR.tcTypeTestErased(NicePrint.minimalStringOfType denv tgtTy, NicePrint.minimalStringOfType denv (stripTyEqnsWrtErasure EraseAll g tgtTy)), m))
     else
-        for ety in getErasedTypes g tgtTy true do
+        let checkTrgtNullness = 
+            match (srcTy,g),(tgtTy,g) with
+            | (NullableRefType|NullTrueValue|NullableTypar), WithoutNullRefType when g.checkNullness && isCast -> 
+                let srcNice = NicePrint.minimalStringOfTypeWithNullness denv srcTy
+                let tgtNice = NicePrint.minimalStringOfTypeWithNullness denv tgtTy
+                warning(Error(FSComp.SR.tcDowncastFromNullableToWithoutNull(srcNice,tgtNice,tgtNice), m))
+                false
+            | (NullableRefType|NullTrueValue|NullableTypar), (NullableRefType|NullTrueValue|NullableTypar) -> not isCast //a type test (unlike type cast) will never return true for  null in the source, therefore adding |null to target does not help => keep the erasure warning
+            | _ -> true
+        for ety in getErasedTypes g tgtTy checkTrgtNullness do
             if isMeasureTy g ety then
                 warning(Error(FSComp.SR.tcTypeTestLosesMeasures(NicePrint.minimalStringOfType denv ety), m))
             else
-                warning(Error(FSComp.SR.tcTypeTestLossy(NicePrint.minimalStringOfType denv ety, NicePrint.minimalStringOfType denv (stripTyEqnsWrtErasure EraseAll g ety)), m))
+                warning(Error(FSComp.SR.tcTypeTestLossy(NicePrint.minimalStringOfTypeWithNullness denv ety, NicePrint.minimalStringOfType denv (stripTyEqnsWrtErasure EraseAll g ety)), m))
 
 ///  Checks, warnings and constraint assertions for upcasts
 let TcStaticUpcast (cenv: cenv) denv m tgtTy srcTy =
@@ -6118,7 +6127,10 @@ and TcExprDowncast (cenv: cenv) overallTy env tpenv (synExpr, synInnerExpr, m) =
 
     // TcRuntimeTypeTest ensures tgtTy is a nominal type. Hence we can insert a check here
     // based on the nullness semantics of the nominal type.
-    let expr = mkCallUnbox g m tgtTy innerExpr
+    let expr = 
+        match (tgtTy,g) with
+        | NullTrueValue | NullableRefType | NullableTypar when g.checkNullness -> mkCallUnboxFast g m tgtTy innerExpr   
+        | _ ->  mkCallUnbox g m tgtTy innerExpr
     expr, tpenv
 
 and TcExprLazy (cenv: cenv) overallTy env tpenv (synInnerExpr, m) =

src/Compiler/Checking/MethodCalls.fs

@@ -1771,7 +1771,7 @@ module ProvidedMethodCalls =
                     | _ when typeEquiv g normTy g.float32_ty -> Const.Single(v :?> float32)
                     | _ when typeEquiv g normTy g.float_ty -> Const.Double(v :?> float)
                     | _ when typeEquiv g normTy g.char_ty -> Const.Char(v :?> char)
-                    | _ when typeEquiv g normTy g.string_ty -> Const.String(v :?> string)
+                    | _ when typeEquiv g normTy g.string_ty -> Const.String(!!v :?> string)
                     | _ when typeEquiv g normTy g.decimal_ty -> Const.Decimal(v :?> decimal)
                     | _ when typeEquiv g normTy g.unit_ty -> Const.Unit
                     | _ -> fail()

src/Compiler/Checking/NicePrint.fs

@@ -2954,3 +2954,6 @@ let minimalStringOfType denv ty =
     let denv = suppressNullnessAnnotations denv
     let denvMin = { denv with showInferenceTyparAnnotations=false; showStaticallyResolvedTyparAnnotations=false }
     showL (PrintTypes.layoutTypeWithInfoAndPrec denvMin SimplifyTypes.typeSimplificationInfo0 2 ty)
+
+let minimalStringOfTypeWithNullness denv ty = 
+    minimalStringOfType {denv with showNullnessAnnotations = Some true} ty

src/Compiler/Checking/NicePrint.fsi

@@ -173,3 +173,5 @@ val minimalStringsOfTwoValues:
     denv: DisplayEnv -> infoReader: InfoReader -> vref1: ValRef -> vref2: ValRef -> string * string
 
 val minimalStringOfType: denv: DisplayEnv -> ty: TType -> string
+
+val minimalStringOfTypeWithNullness: denv: DisplayEnv -> ty: TType -> string

src/Compiler/DependencyManager/AssemblyResolveHandler.fs

@@ -41,7 +41,7 @@ type AssemblyResolveHandlerCoreclr(assemblyProbingPaths: AssemblyResolutionProbe
 
     member _.ResolveAssemblyNetStandard (ctxt: 'T) (assemblyName: AssemblyName) : Assembly =
         let loadAssembly path =
-            loadFromAssemblyPathMethod.Invoke(ctxt, [| path |]) :?> Assembly
+            !! loadFromAssemblyPathMethod.Invoke(ctxt, [| path |]) :?> Assembly
 
         let assemblyPaths =
             match assemblyProbingPaths with

src/Compiler/DependencyManager/DependencyProvider.fs

@@ -168,7 +168,7 @@ type ReflectionDependencyManagerProvider
     let keyProperty (x: objnull) = x |> keyProperty.GetValue |> string
 
     let helpMessagesProperty (x: objnull) =
-        let toStringArray (o: objnull) = o :?> string[]
+        let toStringArray (o: objnull) = !!o :?> string[]
 
         match helpMessagesProperty with
         | Some helpMessagesProperty -> x |> helpMessagesProperty.GetValue |> toStringArray
@@ -334,31 +334,31 @@ type ReflectionDependencyManagerProvider
             member _.StdOut =
                 match getInstanceProperty<string[]> (result.GetType()) "StdOut" with
                 | None -> [||]
-                | Some p -> p.GetValue(result) :?> string[]
+                | Some p -> !! p.GetValue(result) :?> string[]
 
             /// The resolution error log (* process stderror *)
             member _.StdError =
                 match getInstanceProperty<string[]> (result.GetType()) "StdError" with
                 | None -> [||]
-                | Some p -> p.GetValue(result) :?> string[]
+                | Some p -> !! p.GetValue(result) :?> string[]
 
             /// The resolution paths
             member _.Resolutions =
                 match getInstanceProperty<seq<string>> (result.GetType()) "Resolutions" with
                 | None -> Seq.empty<string>
-                | Some p -> p.GetValue(result) :?> seq<string>
+                | Some p -> !! p.GetValue(result) :?> seq<string>
 
             /// The source code file paths
             member _.SourceFiles =
                 match getInstanceProperty<seq<string>> (result.GetType()) "SourceFiles" with
                 | None -> Seq.empty<string>
-                | Some p -> p.GetValue(result) :?> seq<string>
+                | Some p -> !! p.GetValue(result) :?> seq<string>
 
             /// The roots to package directories
             member _.Roots =
                 match getInstanceProperty<seq<string>> (result.GetType()) "Roots" with
                 | None -> Seq.empty<string>
-                | Some p -> p.GetValue(result) :?> seq<string>
+                | Some p -> !! p.GetValue(result) :?> seq<string>
         }
 
     static member MakeResultFromFields
@@ -473,8 +473,8 @@ type ReflectionDependencyManagerProvider
                         match tupleFields |> Array.length with
                         | 3 ->
                             tupleFields[0] :?> bool,
-                            tupleFields[1] :?> string list |> List.toSeq,
-                            tupleFields[2] :?> string list |> List.distinct |> List.toSeq
+                            !!tupleFields[1] :?> string list |> List.toSeq,
+                            !!tupleFields[2] :?> string list |> List.distinct |> List.toSeq
                         | _ -> false, seqEmpty, seqEmpty
 
                     ReflectionDependencyManagerProvider.MakeResultFromFields(success, [||], [||], Seq.empty, sourceFiles, packageRoots)

src/Compiler/FSComp.txt

@@ -1537,6 +1537,7 @@ tcPassingWithoutNullToNonNullAP,"You can remove this |Null|NonNull| pattern usag
 tcPassingWithoutNullToNonNullQuickAP,"You can remove this |NonNullQuick| pattern usage."
 tcPassingWithoutNullTononNullFunction,"You can remove this `nonNull` assertion."
 3263,tcNullableToStringOverride,"With nullness checking enabled, overrides of .ToString() method must return a non-nullable string. You can handle potential nulls via the built-in string function."
+3264,tcDowncastFromNullableToWithoutNull,"Nullness warning: Downcasting from '%s' into '%s' can introduce unexpected null values. Cast to '%s|null' instead or handle the null before downcasting."
 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/Interactive/fsi.fs

@@ -122,7 +122,7 @@ module internal Utilities =
             }
         else
             let specialized = typedefof<AnyToLayoutSpecialization<_>>.MakeGenericType [| ty |]
-            Activator.CreateInstance(specialized) :?> IAnyToLayoutCall
+            !! Activator.CreateInstance(specialized) :?> IAnyToLayoutCall
 
     let callStaticMethod (ty: Type) name args =
         ty.InvokeMember(
@@ -4762,7 +4762,7 @@ type FsiEvaluationSession
     let makeNestedException (userExn: #Exception) =
         // clone userExn -- make userExn the inner exception, to retain the stacktrace on raise
         let arguments = [| userExn.Message :> obj; userExn :> obj |]
-        Activator.CreateInstance(userExn.GetType(), arguments) :?> Exception
+        !! Activator.CreateInstance(userExn.GetType(), arguments) :?> Exception
 
     let commitResult res =
         match res with

src/Compiler/TypedTree/TypeProviders.fs

@@ -141,10 +141,10 @@ let CreateTypeProvider (
                 IsHostedExecution= isInteractive, 
                 SystemRuntimeAssemblyVersion = systemRuntimeAssemblyVersion)
 #endif
-        protect (fun () -> Activator.CreateInstance(typeProviderImplementationType, [| box e|]) :?> ITypeProvider )
+        protect (fun () -> !!(Activator.CreateInstance(typeProviderImplementationType, [| box e|])) :?> ITypeProvider )
 
     elif not(isNull(typeProviderImplementationType.GetConstructor [| |])) then 
-        protect (fun () -> Activator.CreateInstance typeProviderImplementationType :?> ITypeProvider )
+        protect (fun () -> !!(Activator.CreateInstance typeProviderImplementationType) :?> ITypeProvider )
 
     else
         // No appropriate constructor found
@@ -739,7 +739,7 @@ type ProvidedMethodBase (x: MethodBase, ctxt) =
                 let paramsAsObj = 
                     try (!!meth).Invoke(provider, bindingFlags ||| BindingFlags.InvokeMethod, null, [| box x |], null) 
                     with err -> raise (StripException (StripException err))
-                paramsAsObj :?> ParameterInfo[] 
+                !!paramsAsObj :?> ParameterInfo[] 
 
         staticParams |> ProvidedParameterInfo.CreateArrayNonNull ctxt
 

src/Compiler/TypedTree/TypedTreeOps.fs

@@ -9252,6 +9252,7 @@ let TypeNullNotLiked g m ty =
     && not (TypeNullIsTrueValue g ty) 
     && not (TypeNullNever g ty) 
 
+
 let rec TypeHasDefaultValueAux isNew g m ty = 
     let ty = stripTyEqnsAndMeasureEqns g ty
     (if isNew then TypeNullIsExtraValueNew g m ty else TypeNullIsExtraValue g m ty)
@@ -9318,15 +9319,37 @@ let (|SpecialEquatableHeadType|_|) g ty = (|SpecialComparableHeadType|_|) g ty
 let (|SpecialNotEquatableHeadType|_|) g ty = 
     if isFunTy g ty then ValueSome() else ValueNone
 
+let (|TyparTy|NullableTypar|StructTy|NullTrueValue|NullableRefType|WithoutNullRefType|UnresolvedRefType|) (ty,g) = 
+    let sty = ty |> stripTyEqns g
+    if isTyparTy g sty then 
+        if (nullnessOfTy g sty).TryEvaluate() = ValueSome NullnessInfo.WithNull then
+            NullableTypar
+        else
+            TyparTy
+    elif isStructTy g sty then 
+        StructTy
+    elif TypeNullIsTrueValue g sty then
+        NullTrueValue
+    else
+        match (nullnessOfTy g sty).TryEvaluate() with
+        | ValueSome NullnessInfo.WithNull -> NullableRefType
+        | ValueSome NullnessInfo.WithoutNull -> WithoutNullRefType
+        | _ -> UnresolvedRefType
+
 // Can we use the fast helper for the 'LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric'? 
 let canUseTypeTestFast g ty = 
      not (isTyparTy g ty) && 
      not (TypeNullIsTrueValue g ty)
 
 // Can we use the fast helper for the 'LanguagePrimitives.IntrinsicFunctions.UnboxGeneric'? 
-let canUseUnboxFast g m ty = 
-     not (isTyparTy g ty) && 
-     not (TypeNullNotLiked g m ty)
+let canUseUnboxFast (g:TcGlobals) m ty = 
+     if g.checkNullness then
+         match (ty,g) with
+         | TyparTy | WithoutNullRefType | UnresolvedRefType  -> false
+         | StructTy | NullTrueValue | NullableRefType | NullableTypar  -> true
+     else
+         not (isTyparTy g ty) && 
+         not (TypeNullNotLiked g m ty)
 
 //--------------------------------------------------------------------------
 // Nullness tests and pokes 

src/Compiler/TypedTree/TypedTreeOps.fsi

@@ -2608,6 +2608,9 @@ val (|SpecialEquatableHeadType|_|): TcGlobals -> TType -> TType list voption
 [<return: Struct>]
 val (|SpecialNotEquatableHeadType|_|): TcGlobals -> TType -> unit voption
 
+val (|TyparTy|NullableTypar|StructTy|NullTrueValue|NullableRefType|WithoutNullRefType|UnresolvedRefType|):
+    TType * TcGlobals -> Choice<unit, unit, unit, unit, unit, unit, unit>
+
 /// Matches if the given expression is an application
 /// of the range or range-step operator on an integral type
 /// and returns the type, start, step, and finish if so.

src/Compiler/Utilities/TaggedCollections.fs

@@ -667,8 +667,8 @@ type internal Set<'T, 'ComparerTag> when 'ComparerTag :> IComparer<'T>(comparer:
     interface System.IComparable with
         // Cast s2 to the exact same type as s1, see 4884.
         // It is not OK to cast s2 to seq<'T>, since different compares could permute the elements.
-        member s1.CompareTo(s2: obj) =
-            SetTree.compare s1.Comparer s1.Tree (s2 :?> Set<'T, 'ComparerTag>).Tree
+        member s1.CompareTo(s2: objnull) =
+            SetTree.compare s1.Comparer s1.Tree (!!s2 :?> Set<'T, 'ComparerTag>).Tree
 
     member this.ComputeHashCode() =
         let combineHash x y = (x <<< 1) + y + 631
@@ -1239,7 +1239,7 @@ type internal Map<'Key, 'T, 'ComparerTag> when 'ComparerTag :> IComparer<'Key>(c
         | _ -> false
 
     interface System.IComparable with
-        member m1.CompareTo(m2: obj) =
+        member m1.CompareTo(m2: objnull) =
             Seq.compareWith
                 (fun (kvp1: KeyValuePair<_, _>) (kvp2: KeyValuePair<_, _>) ->
                     let c = m1.Comparer.Compare(kvp1.Key, kvp2.Key) in
@@ -1251,7 +1251,7 @@ type internal Map<'Key, 'T, 'ComparerTag> when 'ComparerTag :> IComparer<'Key>(c
                 // Cast m2 to the exact same type as m1, see 4884.
                 // It is not OK to cast m2 to seq<KeyValuePair<'Key,'T>>, since different compares could permute the KVPs.
                 m1
-                (m2 :?> Map<'Key, 'T, 'ComparerTag>)
+                (!!m2 :?> Map<'Key, 'T, 'ComparerTag>)
 
     member this.ComputeHashCode() =
         let combineHash x y = (x <<< 1) + y + 631