diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index ada2ea0abca..111d28790e0 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -483,8 +483,9 @@ let UnifyOverallType (cenv: cenv) (env: TcEnv) m overallTy actualTy = match overallTy with | MustConvertTo(isMethodArg, reqdTy) when g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions -> let actualTy = tryNormalizeMeasureInType g actualTy - let reqdTy = tryNormalizeMeasureInType g reqdTy - if AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m reqdTy actualTy then + let reqdTy = tryNormalizeMeasureInType g reqdTy + let reqTyForUnification = reqTyForArgumentNullnessInference g actualTy reqdTy + if AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m reqTyForUnification actualTy then () else // try adhoc type-directed conversions diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 09eedf6c706..299850d542f 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1081,6 +1081,8 @@ and SolveNullnessSubsumesNullness (csenv: ConstraintSolverEnv) m2 (trace: Option SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 nv1.Solution nullness2 | _, Nullness.Variable nv2 when nv2.IsSolved -> SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 nullness1 nv2.Solution + | Nullness.Variable _nv1, Nullness.Known NullnessInfo.WithoutNull -> + CompleteD | Nullness.Variable nv1, _ -> trace.Exec (fun () -> nv1.Set nullness2) (fun () -> nv1.Unset()) CompleteD @@ -1414,6 +1416,8 @@ and SolveFunTypeEqn csenv ndeep m2 trace cxsln domainTy1 domainTy2 rangeTy1 rang trackErrors { // TODO NULLNESS: consider whether flipping the actual and expected in argument position // causes other problems, e.g. better/worse diagnostics + let g = csenv.g + let domainTy2 = reqTyForArgumentNullnessInference g domainTy1 domainTy2 do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln domainTy2 domainTy1 return! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln rangeTy1 rangeTy2 } diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index d5e5abf7777..25f9d420f2e 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -480,7 +480,7 @@ let MakeCalledArgs amap m (minfo: MethInfo) minst = IsOutArg=isOutArg ReflArgInfo=reflArgInfo NameOpt=nmOpt - CalledArgumentType=calledArgTy }) + CalledArgumentType= changeWithNullReqTyToVariable amap.g calledArgTy}) /// /// Represents the syntactic matching between a caller of a method and the called method. diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fs b/src/Compiler/TypedTree/TypedTreeBasics.fs index dcde4261740..3217aca41bb 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fs +++ b/src/Compiler/TypedTree/TypedTreeBasics.fs @@ -236,18 +236,22 @@ let rec stripUnitEqnsAux canShortcut unt = | _ -> unt let combineNullness (nullnessOrig: Nullness) (nullnessNew: Nullness) = - match nullnessOrig.Evaluate() with - | NullnessInfo.WithoutNull -> nullnessNew - | NullnessInfo.AmbivalentToNull -> - match nullnessNew.Evaluate() with - | NullnessInfo.WithoutNull -> nullnessOrig - | NullnessInfo.AmbivalentToNull -> nullnessOrig - | NullnessInfo.WithNull -> nullnessNew - | NullnessInfo.WithNull -> - match nullnessNew.Evaluate() with - | NullnessInfo.WithoutNull -> nullnessOrig - | NullnessInfo.AmbivalentToNull -> nullnessNew - | NullnessInfo.WithNull -> nullnessOrig + match nullnessOrig, nullnessNew with + | Nullness.Variable _, Nullness.Known NullnessInfo.WithoutNull -> + nullnessOrig + | _ -> + match nullnessOrig.Evaluate() with + | NullnessInfo.WithoutNull -> nullnessNew + | NullnessInfo.AmbivalentToNull -> + match nullnessNew.Evaluate() with + | NullnessInfo.WithoutNull -> nullnessOrig + | NullnessInfo.AmbivalentToNull -> nullnessOrig + | NullnessInfo.WithNull -> nullnessNew + | NullnessInfo.WithNull -> + match nullnessNew.Evaluate() with + | NullnessInfo.WithoutNull -> nullnessOrig + | NullnessInfo.AmbivalentToNull -> nullnessNew + | NullnessInfo.WithNull -> nullnessOrig let nullnessEquiv (nullnessOrig: Nullness) (nullnessNew: Nullness) = LanguagePrimitives.PhysicalEquality nullnessOrig nullnessNew @@ -278,8 +282,9 @@ let tryAddNullnessToTy nullnessNew (ty:TType) = | TType_measure _ -> None let addNullnessToTy (nullness: Nullness) (ty:TType) = - match nullness.Evaluate() with - | NullnessInfo.WithoutNull -> ty + match nullness with + | Nullness.Known NullnessInfo.WithoutNull -> ty + | Nullness.Variable nv when nv.IsSolved && nv.Evaluate() = NullnessInfo.WithoutNull -> ty | _ -> match ty with | TType_var (tp, nullnessOrig) -> TType_var (tp, combineNullness nullnessOrig nullness) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 00e0ee4d7f1..9bb87cfc5f8 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -9157,11 +9157,33 @@ let nullnessOfTy g ty = |> function | TType_app(tcref, _, nullness) -> let nullness2 = intrinsicNullnessOfTyconRef g tcref - combineNullness nullness nullness2 + if nullness2 === g.knownWithoutNull then + nullness + else + combineNullness nullness nullness2 | TType_fun (_, _, nullness) | TType_var (_, nullness) -> nullness | _ -> g.knownWithoutNull +let changeWithNullReqTyToVariable g reqTy = + let sty = stripTyEqns g reqTy + match isTyparTy g sty with + | false -> + match nullnessOfTy g sty with + | Nullness.Known NullnessInfo.WithNull -> + reqTy |> replaceNullnessOfTy (NewNullnessVar()) + | _ -> reqTy + | true -> reqTy + +/// When calling a null-allowing API, we prefer to infer a without null argument for idiomatic F# code. +/// That is, unless caller explicitely marks a value (e.g. coming from a function parameter) as WithNull, it should not be infered as such. +let reqTyForArgumentNullnessInference g actualTy reqTy = + // Only change reqd nullness if actualTy is an inference variable + match tryDestTyparTy g actualTy with + | ValueSome t when t.IsCompilerGenerated && not(t.Constraints |> List.exists(function | TyparConstraint.SupportsNull _ -> true | _ -> false))-> + changeWithNullReqTyToVariable g reqTy + | _ -> reqTy + /// The new logic about whether a type admits the use of 'null' as a value. let TypeNullIsExtraValueNew g m ty = let sty = stripTyparEqns ty diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 64882210a53..4b23da1836c 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -649,6 +649,10 @@ val tryDestForallTy: TcGlobals -> TType -> Typars * TType val nullnessOfTy: TcGlobals -> TType -> Nullness +val changeWithNullReqTyToVariable: TcGlobals -> reqTy: TType -> TType + +val reqTyForArgumentNullnessInference: TcGlobals -> actualTy: TType -> reqTy: TType -> TType + val isFunTy: TcGlobals -> TType -> bool val isForallTy: TcGlobals -> TType -> bool diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/ReferenceDU.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/ReferenceDU.fs index b4d87d8293d..01c56c32109 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/ReferenceDU.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/ReferenceDU.fs @@ -8,7 +8,7 @@ type MyDu = let giveMeLabel () = JustLabel -let createMaybeString (innerValue) = MaybeString innerValue +let createMaybeString (innerValue:string|null) = MaybeString innerValue let processNullableDu (x : (MyDu | null)) : string | null = match x with diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 2a7e5a74d87..0a409783185 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -29,6 +29,75 @@ let nonStrictFunc(x:string | null) = strictFunc(x) |> withDiagnostics [ Error 3261, Line 4, Col 49, Line 4, Col 50, "Nullness warning: The types 'string' and 'string | null' do not have equivalent nullability."] +[] +[] +[] +[] +[ fileExists")>] +[ fileExists")>] +[] +[] +[ System.IO.File.Exists")>] +[ System.IO.File.Exists")>] +[] +let ``Calling a nullAllowing API can still infer a withoutNull type``(functionCall) = + FSharp $""" +module MyLib + +let myStrictFunc(x: string) = x.GetHashCode() +let fileExists (path:string|null) = true + +let myStringReturningFunc (path) = + let ex = {functionCall} + myStrictFunc(path) + """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + +//[] +// TODO Tomas - as of now, this does not bring the desired result +let ``Type inference with underscore or null`` () = + FSharp $""" +module MyLib + +let myFunc (path: _ | null) = + System.IO.File.Exists(path) + """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + +[] +let ``Type inference SystemIOFileExists`` () = + FSharp $""" +module MyLib + +let test() = + let maybeString : string | null = null + System.IO.File.Exists(maybeString) + +let myFunc path : string = + let exists = path |> System.IO.File.Exists + path + """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + +[] +let ``Type inference fsharp func`` () = + FSharp $"""module MyLib + +let fileExists (path:string|null) = true +let myStringReturningFunc (pathArg) : string = + let ex = pathArg |> fileExists + pathArg + """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + // P1: inline or not // P2: type annotation for function argument diff --git a/tests/adhoc/nullness/enabled/positive.fs b/tests/adhoc/nullness/enabled/positive.fs index 66c3847d3b3..30d1b647779 100644 --- a/tests/adhoc/nullness/enabled/positive.fs +++ b/tests/adhoc/nullness/enabled/positive.fs @@ -92,10 +92,10 @@ module KonsoleWithNullsModule = let WriteLineC2(fmt: C | null, arg1: C | null) = Console.WriteLine(fmt.Value, arg1.Value) module KonsoleWithNullsModule2 = - let WriteLine x = KonsoleWithNullsModule.WriteLine x - let WriteLine2 (fmt, arg1) = KonsoleWithNullsModule.WriteLine2(fmt, arg1) - let WriteLineC(s) = KonsoleWithNullsModule.WriteLineC(s) - let WriteLineC2(fmt, arg1) = KonsoleWithNullsModule.WriteLineC2(fmt, arg1) + let WriteLine (x : string | null) = KonsoleWithNullsModule.WriteLine x + let WriteLine2 (fmt: string | null, arg1: string | null) = KonsoleWithNullsModule.WriteLine2(fmt, arg1) + let WriteLineC(s: _ | null) = KonsoleWithNullsModule.WriteLineC(s) + let WriteLineC2(fmt: _ | null, arg1: _ | null) = KonsoleWithNullsModule.WriteLineC2(fmt, arg1) type KonsoleNoNulls = static member WriteLine(s: String) = Console.WriteLine(s)