Bugfix: Warn when upcast drops nullness via FindUniqueFeasibleSupertype (#18261)

* Warn when upcast drops nullness via FindUniqueFeasibleSupertype

* temporary null shutuops  before `use` is softened

* notes added

Author: T-Gro

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

@@ -3,6 +3,7 @@
 * Fix optimizer internal error for records with static fields  ([Issue #18165](https://github.com/dotnet/fsharp/issues/18165), [PR #18280](https://github.com/dotnet/fsharp/pull/18280))
 * Fix internal error when missing measure attribute in an unsolved measure typar. ([Issue #7491](https://github.com/dotnet/fsharp/issues/7491), [PR #18234](https://github.com/dotnet/fsharp/pull/18234)==
 * Set `Cancellable.token` from async computation ([Issue #18235](https://github.com/dotnet/fsharp/issues/18235), [PR #18238](https://github.com/dotnet/fsharp/pull/18238))
+* Fix missing nullness warning when static upcast dropped nullness ([Issue #18232](https://github.com/dotnet/fsharp/issues/18232), [PR #18261](https://github.com/dotnet/fsharp/pull/18261))
 * Cancellable: only cancel on OCE with own token ([PR #18277](https://github.com/dotnet/fsharp/pull/18277))
 * Cancellable: set token in more places ([PR #18283](https://github.com/dotnet/fsharp/pull/18283))
 

src/Compiler/Checking/TypeRelations.fs

@@ -341,5 +341,13 @@ let IteratedAdjustLambdaToMatchValReprInfo g amap valReprInfo lambdaExpr =
 /// "Single Feasible Type" inference
 /// Look for the unique supertype of ty2 for which ty2 :> ty1 might feasibly hold
 let FindUniqueFeasibleSupertype g amap m ty1 ty2 =
-    let supertypes = Option.toList (GetSuperTypeOfType g amap m ty2) @ (GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m ty2)
-    supertypes |> List.tryFind (TypeFeasiblySubsumesType 0 g amap m ty1 NoCoerce)
+    let n2 = nullnessOfTy g ty2
+    let nullify t = addNullnessToTy n2 t
+
+    let supertypes = 
+        Option.toList (GetSuperTypeOfType g amap m ty2) @ 
+        (GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes g amap m ty2)
+
+    supertypes 
+    |> List.tryFind (TypeFeasiblySubsumesType 0 g amap m ty1 NoCoerce)
+    |> Option.map nullify

src/Compiler/Utilities/Activity.fs

@@ -93,14 +93,14 @@ module internal Activity =
         let activity = activitySource.CreateActivity(name, ActivityKind.Internal)
 
         match activity with
-        | null -> activity
+        | null -> !!activity //TODO change retTy to |null after PR #18262 is merged!!
         | activity ->
             for key, value in tags do
                 activity.AddTag(key, value) |> ignore
 
             activity.Start()
 
-    let startNoTags (name: string) : IDisposable = activitySource.StartActivity name
+    let startNoTags (name: string) : IDisposable = !! (activitySource.StartActivity name) //TODO change retTy to |null after PR #18262 is merged!!
 
     let addEvent name =
         match Activity.Current with
@@ -122,7 +122,7 @@ module internal Activity =
 
         let private profiledSource = new ActivitySource(ActivityNames.ProfiledSourceName)
 
-        let startAndMeasureEnvironmentStats (name: string) : IDisposable = profiledSource.StartActivity(name)
+        let startAndMeasureEnvironmentStats (name: string) : IDisposable = !!(profiledSource.StartActivity(name)) //TODO change retTy to |null after PR #18262 is merged!!
 
         type private GCStats = int[]
 

tests/FSharp.Compiler.ComponentTests/Language/Nullness/NullableReferenceTypesTests.fs

@@ -17,6 +17,20 @@ let typeCheckWithStrictNullness cu =
     |> withNullnessOptions
     |> typecheck
 
+[<Fact>]
+let ``Warning on nullness hidden behind interface upcast`` () =
+    FSharp """module Test
+
+open System.IO
+open System
+
+// This is bad - input is nullable, output is not = must warn
+let whatisThis (s:Stream|null) : IDisposable =
+    s"""
+    |> asLibrary
+    |> typeCheckWithStrictNullness
+    |> shouldFail
+    |> withDiagnostics [Error 3261, Line 8, Col 5, Line 8, Col 6, "Nullness warning: The types 'IDisposable' and 'IDisposable | null' do not have compatible nullability."]
 
 [<FSharp.Test.FactForNETCOREAPPAttribute>]
 let ``Report warning when applying anon record to a nullable generic return value`` () =