Nullness bugfix - change isObjTy early returns in ConstraintSolver (#17757)

Author: T-Gro

.fantomasignore

@@ -117,6 +117,9 @@ src/Compiler/Facilities/AsyncMemoize.fsi
 src/Compiler/Facilities/AsyncMemoize.fs
 src/Compiler/AbstractIL/il.fs
 
+src/Compiler/Driver/GraphChecking/Graph.fsi
+src/Compiler/Driver/GraphChecking/Graph.fs
+
 # Fantomas limitations on implementation files  (to investigate)
 
 src/Compiler/AbstractIL/ilwrite.fs

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

@@ -1,11 +1,11 @@
 ### Fixed
 
+* Fix false negatives for passing null to "obj" arguments. Only "obj | null" can now subsume any type ([PR #17757](https://github.com/dotnet/fsharp/pull/17757))
 * Fix internal error when calling 'AddSingleton' and other overloads only differing in generic arity ([PR #17804](https://github.com/dotnet/fsharp/pull/17804))
 * Fix extension methods support for non-reference system assemblies ([PR #17799](https://github.com/dotnet/fsharp/pull/17799))
 * Ensure `frameworkTcImportsCache` mutations are thread-safe. ([PR #17795](https://github.com/dotnet/fsharp/pull/17795))
 * Fix concurrency issue in `ILPreTypeDefImpl`  ([PR #17812](https://github.com/dotnet/fsharp/pull/17812))
 
-
 ### Added
 
 

src/Compiler/AbstractIL/ilreflect.fs

@@ -277,7 +277,7 @@ type TypeBuilder with
 
         match m with
         | null -> raise (MissingMethodException nm)
-        | m -> m.Invoke(null, args)
+        | m -> m.Invoke(null, (args: obj array))
 
     member typB.SetCustomAttributeAndLog(cinfo, bytes) =
         if logRefEmitCalls then

src/Compiler/Checking/AttributeChecking.fs

@@ -466,9 +466,9 @@ let MethInfoIsUnseen g (m: range) (ty: TType) minfo =
 
     let isUnseenByHidingAttribute () = 
 #if !NO_TYPEPROVIDERS
-        not (isObjTy g ty) &&
+        not (isObjTyAnyNullness g ty) &&
         isAppTy g ty &&
-        isObjTy g minfo.ApparentEnclosingType &&
+        isObjTyAnyNullness g minfo.ApparentEnclosingType &&
         let tcref = tcrefOfAppTy g ty 
         match tcref.TypeReprInfo with 
         | TProvidedTypeRepr info -> 

src/Compiler/Checking/ConstraintSolver.fs

@@ -3283,7 +3283,7 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr
 
         let enumElemTy =
 
-            if isObjTy g enumElemTy then
+            if isObjTyAnyNullness g enumElemTy then
                 // Look for an 'Item' property, or a set of these with consistent return types
                 let allEquivReturnTypes (minfo: MethInfo) (others: MethInfo list) =
                     let returnTy = minfo.GetFSharpReturnType(cenv.amap, m, [])
@@ -6195,7 +6195,7 @@ and TcExprObjectExpr (cenv: cenv) overallTy env tpenv (synObjTy, argopt, binds,
                 errorR(Error(FSComp.SR.tcCannotInheritFromErasedType(), m))
             (m, intfTy, overrides), tpenv)
 
-    let realObjTy = if isObjTy g objTy && not (isNil extraImpls) then (p23 (List.head extraImpls)) else objTy
+    let realObjTy = if isObjTyAnyNullness g objTy && not (isNil extraImpls) then (p23 (List.head extraImpls)) else objTy
 
     TcPropagatingExprLeafThenConvert cenv overallTy realObjTy env (* canAdhoc *) m (fun () ->
         TcObjectExpr cenv env tpenv (objTy, realObjTy, argopt, binds, extraImpls, mObjTy, mNewExpr, m)
@@ -7320,7 +7320,7 @@ and TcFormatStringExpr cenv (overallTy: OverallTy) env m tpenv (fmtString: strin
     let formatTy = mkPrintfFormatTy g aty bty cty dty ety
 
     // This might qualify as a format string - check via a type directed rule
-    let ok = not (isObjTy g overallTy.Commit) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit formatTy
+    let ok = not (isObjTyAnyNullness g overallTy.Commit) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit formatTy
 
     if ok then
         // Parse the format string to work out the phantom types
@@ -7399,7 +7399,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn
             Choice1Of2 (true, newFormatMethod)
 
         // ... or if that fails then may be a FormattableString by a type-directed rule....
-        elif (not (isObjTy g overallTy.Commit) &&
+        elif (not (isObjTyAnyNullness g overallTy.Commit) &&
               ((g.system_FormattableString_tcref.CanDeref && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit g.system_FormattableString_ty)
                || (g.system_IFormattable_tcref.CanDeref && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit g.system_IFormattable_ty))) then
 
@@ -7420,7 +7420,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn
             | None -> languageFeatureNotSupportedInLibraryError LanguageFeature.StringInterpolation m
 
         // ... or if that fails then may be a PrintfFormat by a type-directed rule....
-        elif not (isObjTy g overallTy.Commit) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit formatTy then
+        elif not (isObjTyAnyNullness g overallTy.Commit) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit formatTy then
 
             // And if that succeeds, the printerTy and printerResultTy must be the same (there are no curried arguments)
             UnifyTypes cenv env m printerTy printerResultTy

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -1082,7 +1082,7 @@ let TryDestStandardDelegateType (infoReader: InfoReader) m ad delTy =
     let g = infoReader.g
     let (SigOfFunctionForDelegate(_, delArgTys, delRetTy, _)) = GetSigOfFunctionForDelegate infoReader delTy m ad
     match delArgTys with 
-    | senderTy :: argTys when (isObjTy g senderTy) && not (List.exists (isByrefTy g) argTys)  -> Some(mkRefTupledTy g argTys, delRetTy)
+    | senderTy :: argTys when (isObjTyAnyNullness g senderTy) && not (List.exists (isByrefTy g) argTys)  -> Some(mkRefTupledTy g argTys, delRetTy)
     | _ -> None
 
 

src/Compiler/Checking/InfoReader.fs

@@ -1319,7 +1319,7 @@ let BuildNewDelegateExpr (eventInfoOpt: EventInfo option, g, amap, delegateTy, d
                     | Some einfo -> 
                         match delArgVals with 
                         | [] -> error(nonStandardEventError einfo.EventName m)
-                        | h :: _ when not (isObjTy g h.Type) -> error(nonStandardEventError einfo.EventName m)
+                        | h :: _ when not (isObjTyAnyNullness g h.Type) -> error(nonStandardEventError einfo.EventName m)
                         | h :: t -> [exprForVal m h; mkRefTupledVars g m t] 
                     | None -> 
                         if isNil delArgTys then [mkUnit g m] else List.map (exprForVal m) delArgVals

src/Compiler/Checking/MethodCalls.fs

@@ -4422,14 +4422,14 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso
         //
         // Don't show GetHashCode or Equals for F# types that admit equality as an abnormal operation
         let isUnseenDueToBasicObjRules =
-            not (isObjTy g ty) &&
+            not (isObjTyAnyNullness g ty) &&
             not minfo.IsExtensionMember &&
             match minfo.LogicalName with
             | "GetType"  -> false
-            | "GetHashCode"  -> isObjTy g minfo.ApparentEnclosingType && not (AugmentTypeDefinitions.TypeDefinitelyHasEquality g ty)
+            | "GetHashCode"  -> isObjTyAnyNullness g minfo.ApparentEnclosingType && not (AugmentTypeDefinitions.TypeDefinitelyHasEquality g ty)
             | "ToString" -> false
             | "Equals" ->
-                if not (isObjTy g minfo.ApparentEnclosingType) then
+                if not (isObjTyAnyNullness g minfo.ApparentEnclosingType) then
                     // declaring type is not System.Object - show it
                     false
                 elif minfo.IsInstance then
@@ -4440,7 +4440,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso
                     true
             | _ ->
                 // filter out self methods of obj type
-                isObjTy g minfo.ApparentEnclosingType
+                isObjTyAnyNullness g minfo.ApparentEnclosingType
 
         let result =
             not isUnseenDueToBasicObjRules &&
@@ -5121,14 +5121,14 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty (
                 //
                 // Don't show GetHashCode or Equals for F# types that admit equality as an abnormal operation
                 let isUnseenDueToBasicObjRules =
-                    not (isObjTy g ty) &&
+                    not (isObjTyAnyNullness g ty) &&
                     not minfo.IsExtensionMember &&
                     match minfo.LogicalName with
                     | "GetType"  -> false
-                    | "GetHashCode"  -> isObjTy g minfo.ApparentEnclosingType && not (AugmentTypeDefinitions.TypeDefinitelyHasEquality g ty)
+                    | "GetHashCode"  -> isObjTyAnyNullness g minfo.ApparentEnclosingType && not (AugmentTypeDefinitions.TypeDefinitelyHasEquality g ty)
                     | "ToString" -> false
                     | "Equals" ->
-                        if not (isObjTy g minfo.ApparentEnclosingType) then
+                        if not (isObjTyAnyNullness g minfo.ApparentEnclosingType) then
                             // declaring type is not System.Object - show it
                             false
                         elif minfo.IsInstance then
@@ -5139,7 +5139,7 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty (
                             true
                     | _ ->
                         // filter out self methods of obj type
-                        isObjTy g minfo.ApparentEnclosingType
+                        isObjTyAnyNullness g minfo.ApparentEnclosingType
                 let result =
                     not isUnseenDueToBasicObjRules &&
                     not minfo.IsInstance = statics &&

src/Compiler/Checking/NameResolution.fs

@@ -2191,7 +2191,7 @@ module TastDefinitionPrinting =
         let inherits = 
             [ if not (suppressInheritanceAndInterfacesForTyInSimplifiedDisplays g amap m ty) then 
                 match GetSuperTypeOfType g amap m ty with 
-                | Some superTy when not (isObjTy g superTy) && not (isValueTypeTy g superTy) ->
+                | Some superTy when not (isObjTyAnyNullness g superTy) && not (isValueTypeTy g superTy) ->
                     superTy
                 | _ -> ()
             ]