Feature nullness - support overrides of nullness annotation in the im…

…ported object hierarchy (#16711)

src/Compiler/Checking/CheckExpressions.fs

@@ -9226,10 +9226,13 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela
 
     let objArgs = [objExpr]
 
-    // 'base' calls use a different resolution strategy when finding methods.
-    let findFlag =
-        let baseCall = IsBaseCall objArgs
-        (if baseCall then PreferOverrides else IgnoreOverrides)
+    let findFlag = 
+        // 'base' calls use a different resolution strategy when finding methods
+        // nullness checks need the overrides, since those can change nullable semantics (e.g. ToString from BCL)
+        if (g.checkNullness && g.langFeatureNullness) || IsBaseCall objArgs then
+            PreferOverrides
+        else
+            IgnoreOverrides
 
     // Canonicalize inference problem prior to '.' lookup on variable types
     if isTyparTy g objExprTy then

src/Compiler/Checking/ConstraintSolver.fs

@@ -3646,7 +3646,13 @@ and GetMostApplicableOverload csenv ndeep candidates applicableMeths calledMethG
                 0
         if c <> 0 then c else
 
-        0
+        // Properties are kept incl. almost-duplicates because of the partial-override possibility.
+        // E.g. base can have get,set and derived only get => we keep both props around until method resolution time.
+        // Now is the type to pick the better (more derived) one.
+        match candidate.AssociatedPropertyInfo,other.AssociatedPropertyInfo,candidate.Method.IsExtensionMember,other.Method.IsExtensionMember with
+        | Some p1, Some p2, false, false -> compareTypes p1.ApparentEnclosingType p2.ApparentEnclosingType
+        | _ -> 0
+
 
     let bestMethods =
         let indexedApplicableMeths = applicableMeths |> List.indexed

src/Compiler/Checking/InfoReader.fs

@@ -644,6 +644,11 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this =
              MethInfosEquivByNameAndSig EraseNone true g amap m,
              (fun minfo -> minfo.LogicalName)) 
 
+    static let PropsGetterSetterEquiv innerEquality (p1:PropInfo) (p2:PropInfo)  : bool =
+        p1.HasGetter = p2.HasGetter &&
+        p1.HasSetter = p2.HasSetter &&
+        innerEquality p1 p2
+
     /// Filter the overrides of properties, either keeping the overrides or keeping the dispatch slots.
     static let FilterOverridesOfPropInfos findFlag g amap m props = 
         props 
@@ -652,7 +657,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this =
                (fun pinfo -> pinfo.IsNewSlot),
                (fun pinfo -> pinfo.IsDefiniteFSharpOverride),
                (fun _ -> false),
-               PropInfosEquivByNameAndSig EraseNone g amap m,
+               PropsGetterSetterEquiv (PropInfosEquivByNameAndSig EraseNone g amap m),
                (fun pinfo -> pinfo.PropertyName)) 
 
     /// Exclude methods from super types which have the same signature as a method in a more specific type.
@@ -670,7 +675,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this =
     /// Exclude properties from super types which have the same name as a property in a more specific type.
     static let ExcludeHiddenOfPropInfosImpl g amap m pinfos = 
         pinfos 
-        |> ExcludeItemsInSuperTypesBasedOnEquivTestWithItemsInSubTypes (fun (pinfo: PropInfo) -> pinfo.PropertyName) (PropInfosEquivByNameAndPartialSig EraseNone g amap m) 
+        |> ExcludeItemsInSuperTypesBasedOnEquivTestWithItemsInSubTypes (fun (pinfo: PropInfo) -> pinfo.PropertyName) (PropsGetterSetterEquiv (PropInfosEquivByNameAndPartialSig EraseNone g amap m)) 
         |> List.concat
 
     /// Make a cache for function 'f' keyed by type (plus some additional 'flags') that only 

src/Compiler/Checking/TypeHierarchy.fs

@@ -56,8 +56,7 @@ let GetSuperTypeOfType g amap m ty =
             let tinst = argsOfAppTy g ty
             match tdef.Extends with
             | None -> None
-                                // 'inherit' cannot refer to a nullable type
-            | Some ilTy -> 
+            | Some ilTy ->   // 'inherit' can refer to a type which has nullable type arguments (e.g. List<string?>)
                 let typeAttrs = AttributesFromIL(tdef.MetadataIndex,tdef.CustomAttrsStored)
                 let nullness = {DirectAttributes = typeAttrs; Fallback = FromClass typeAttrs}
                 Some (RescopeAndImportILType scoref amap m tinst nullness ilTy)

src/Compiler/TypedTree/TcGlobals.fs

@@ -198,6 +198,8 @@ type TcGlobals(
 
   let v_langFeatureNullness = langVersion.SupportsFeature LanguageFeature.NullnessChecking
 
+  let v_renderNullness = checkNullness && v_langFeatureNullness
+
   let v_knownWithNull =
       if v_langFeatureNullness then KnownWithNull else KnownAmbivalentToNull
 
@@ -1105,6 +1107,8 @@ type TcGlobals(
 
   member _.langFeatureNullness = v_langFeatureNullness
 
+  member _.renderNullnessAnnotations = v_renderNullness
+
   member _.knownWithNull = v_knownWithNull
 
   member _.knownWithoutNull = v_knownWithoutNull

src/Compiler/TypedTree/TypedTreeBasics.fs

@@ -245,7 +245,11 @@ let rec stripUnitEqnsAux canShortcut unt =
 let combineNullness (nullnessOrig: Nullness) (nullnessNew: Nullness) = 
     match nullnessOrig.Evaluate() with
     | NullnessInfo.WithoutNull -> nullnessNew
-    | NullnessInfo.AmbivalentToNull -> nullnessOrig
+    | NullnessInfo.AmbivalentToNull ->
+        match nullnessNew.Evaluate() with
+        | NullnessInfo.WithoutNull -> nullnessOrig
+        | NullnessInfo.AmbivalentToNull -> nullnessOrig
+        | NullnessInfo.WithNull -> nullnessNew
     | NullnessInfo.WithNull -> 
         match nullnessNew.Evaluate() with
         | NullnessInfo.WithoutNull -> nullnessOrig

src/Compiler/TypedTree/TypedTreeOps.fs

@@ -1082,6 +1082,18 @@ and typeAEquivAux erasureFlag g aenv ty1 ty2 =
 
     | _ -> false
 
+and nullnessSensitivetypeAEquivAux  erasureFlag g aenv ty1 ty2 = 
+    let ty1 = stripTyEqnsWrtErasure erasureFlag g ty1 
+    let ty2 = stripTyEqnsWrtErasure erasureFlag g ty2
+    match ty1, ty2 with
+    | TType_var (_,n1), TType_var (_,n2)
+    | TType_app (_,_,n1), TType_app (_,_,n2)     
+    | TType_fun (_,_,n1), TType_fun (_,_,n2) ->
+        n1 === n2
+    | _ -> true
+
+    && typeAEquivAux erasureFlag g aenv ty1 ty2
+
 and anonInfoEquiv (anonInfo1: AnonRecdTypeInfo) (anonInfo2: AnonRecdTypeInfo) =
     ccuEq anonInfo1.Assembly anonInfo2.Assembly && 
     structnessAEquiv anonInfo1.TupInfo anonInfo2.TupInfo && 
@@ -8771,6 +8783,9 @@ let typarEnc _g (gtpsType, gtpsMethod) typar =
             warning(InternalError("Typar not found during XmlDoc generation", typar.Range))
             "``0"
 
+let nullnessEnc (g:TcGlobals) (nullness:Nullness) = 
+    if g.renderNullnessAnnotations then nullness.ToFsharpCodeString() else ""
+
 let rec typeEnc g (gtpsType, gtpsMethod) ty = 
     let stripped = stripTyEqnsAndMeasureEqns g ty
     match stripped with 
@@ -8789,7 +8804,7 @@ let rec typeEnc g (gtpsType, gtpsMethod) ty =
         let tcref, tinst = destAppTy g ty        
         let rank = rankOfArrayTyconRef g tcref
         let arraySuffix = "[" + String.concat ", " (List.replicate (rank-1) "0:") + "]"
-        typeEnc g (gtpsType, gtpsMethod) (List.head tinst) + arraySuffix + nullness.ToFsharpCodeString()
+        typeEnc g (gtpsType, gtpsMethod) (List.head tinst) + arraySuffix + nullnessEnc g nullness
 
     | TType_ucase (_, tinst)   
     | TType_app (_, tinst, _) -> 
@@ -8804,7 +8819,7 @@ let rec typeEnc g (gtpsType, gtpsMethod) ty =
             | _ ->
                 assert false
                 failwith "impossible"
-        tyName + tyargsEnc g (gtpsType, gtpsMethod) tinst + nullness.ToFsharpCodeString()
+        tyName + tyargsEnc g (gtpsType, gtpsMethod) tinst + nullnessEnc g nullness
 
     | TType_anon (anonInfo, tinst) -> 
         sprintf "%s%s" anonInfo.ILTypeRef.FullName (tyargsEnc g (gtpsType, gtpsMethod) tinst)
@@ -8816,10 +8831,10 @@ let rec typeEnc g (gtpsType, gtpsMethod) ty =
             sprintf "System.Tuple%s"(tyargsEnc g (gtpsType, gtpsMethod) tys)
 
     | TType_fun (domainTy, rangeTy, nullness) -> 
-        "Microsoft.FSharp.Core.FSharpFunc" + tyargsEnc g (gtpsType, gtpsMethod) [domainTy; rangeTy] + nullness.ToFsharpCodeString()
+        "Microsoft.FSharp.Core.FSharpFunc" + tyargsEnc g (gtpsType, gtpsMethod) [domainTy; rangeTy] + nullnessEnc g nullness
 
     | TType_var (typar, nullness) -> 
-        typarEnc g (gtpsType, gtpsMethod) typar + nullness.ToFsharpCodeString()
+        typarEnc g (gtpsType, gtpsMethod) typar + nullnessEnc g nullness
 
     | TType_measure _ -> "?"
 

src/Compiler/TypedTree/TypedTreeOps.fsi

@@ -896,6 +896,8 @@ val typarsAEquiv: TcGlobals -> TypeEquivEnv -> Typars -> Typars -> bool
 
 val typeAEquivAux: Erasure -> TcGlobals -> TypeEquivEnv -> TType -> TType -> bool
 
+val nullnessSensitivetypeAEquivAux: Erasure -> TcGlobals -> TypeEquivEnv -> TType -> TType -> bool
+
 val typeAEquiv: TcGlobals -> TypeEquivEnv -> TType -> TType -> bool
 
 val returnTypesAEquivAux: Erasure -> TcGlobals -> TypeEquivEnv -> TType option -> TType option -> bool

tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/MethodsAndProperties/MethodsAndProperties.fs

@@ -14,16 +14,23 @@ module MemberDefinitions_MethodsAndProperties =
         |> withOptions ["--nowarn:988"]
         |> compile
 
-    let verifyCompileAndRun compilation =
+    let verifyCompileAndRun = verifyCompile >> run
+
+    // SOURCE=PartiallyOverridenProperty.fs							
+    [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"PartiallyOverridenProperty.fs"|])>]
+    let ``Partially Overriden Property`` compilation =
         compilation
-        |> asExe
-        |> withOptions ["--nowarn:988"]
-        |> compileAndRun
+        |> withLangVersionPreview
+        |> withCheckNulls
+        |> typecheck
+        |> shouldSucceed
 
     // SOURCE=AbstractProperties01.fs								# AbstractProperties01.fs
     [<Theory; Directory(__SOURCE_DIRECTORY__, Includes=[|"AbstractProperties01.fs"|])>]
     let ``AbstractProperties01_fs`` compilation =
         compilation
+        |> withLangVersionPreview
+        |> withCheckNulls
         |> verifyCompileAndRun
         |> shouldSucceed
 

tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/MethodsAndProperties/PartiallyOverridenProperty.fs

@@ -0,0 +1,15 @@
+module MyLib
+
+type BaseType() =
+    abstract Msg : string with get,set
+    default this.Msg 
+        with get() = ""            
+        and  set x = printfn "%s" x
+
+type DerivedType() =
+    inherit BaseType()
+    override this.Msg with get() = "getterOnly"
+
+let d = new DerivedType()
+d.Msg <- "" //invoking setter
+printfn "%s" d.Msg //invoking getter