Nullness - downcasting and typetests should understand nullness information (#17965)

Author: T-Gro

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)