From 6e91fe76ec51e20a3707be0e2b3b037e2f8fe546 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 29 May 2024 12:51:49 +0200 Subject: [PATCH 1/6] adhoc tests --- .../Language/NullableReferenceTypesTests.fs | 58 ++++++++++++++++++- 1 file changed, 57 insertions(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 2a7e5a74d87..316037b8441 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -14,7 +14,7 @@ let withNullnessOptions cu = let typeCheckWithStrictNullness cu = cu |> withNullnessOptions - |> compile + |> typecheck [] let ``Cannot pass possibly null value to a strict function``() = @@ -29,6 +29,62 @@ 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")>] +[] +[ 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 + +[] +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 myStrictFunc(x: string) = x.GetHashCode() +let fileExists (path:string|null) = true + +let myStringReturningFunc (path) = + let ex = fileExists path + myStrictFunc(path) + """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + // P1: inline or not // P2: type annotation for function argument From c35962d71e6e1fd9f51d10b0887d89374b82f1d2 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 30 May 2024 11:59:04 +0200 Subject: [PATCH 2/6] change withNull args for functions and methods (incl. piped) to be an inference variable defaulting to WithoutNull --- src/Compiler/Checking/CheckExpressions.fs | 5 +-- src/Compiler/Checking/ConstraintSolver.fs | 4 +++ src/Compiler/Checking/MethodCalls.fs | 2 +- src/Compiler/TypedTree/TypedTreeBasics.fs | 33 +++++++++++-------- src/Compiler/TypedTree/TypedTreeOps.fs | 24 +++++++++++++- src/Compiler/TypedTree/TypedTreeOps.fsi | 4 +++ .../Language/NullableReferenceTypesTests.fs | 12 +++---- 7 files changed, 58 insertions(+), 26 deletions(-) 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..81afbf17979 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 -> + 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..b7ae4b173a5 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/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 316037b8441..9a5f666627a 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -36,7 +36,6 @@ let nonStrictFunc(x:string | null) = strictFunc(x) [] [ System.IO.File.Exists")>] [] -[] let ``Calling a nullAllowing API can still infer a withoutNull type``(functionCall) = FSharp $""" module MyLib @@ -71,15 +70,12 @@ let myFunc path : string = [] let ``Type inference fsharp func`` () = - FSharp $""" -module MyLib + FSharp $"""module MyLib -let myStrictFunc(x: string) = x.GetHashCode() let fileExists (path:string|null) = true - -let myStringReturningFunc (path) = - let ex = fileExists path - myStrictFunc(path) +let myStringReturningFunc (pathArg) : string = + let ex = pathArg |> fileExists + pathArg """ |> asLibrary |> typeCheckWithStrictNullness From 866ff55846fd88c5eaddbfffecfda9fd65886d38 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 30 May 2024 12:00:38 +0200 Subject: [PATCH 3/6] fantomas --- src/Compiler/TypedTree/TypedTreeOps.fsi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index b7ae4b173a5..4b23da1836c 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -649,9 +649,9 @@ val tryDestForallTy: TcGlobals -> TType -> Typars * TType val nullnessOfTy: TcGlobals -> TType -> Nullness -val changeWithNullReqTyToVariable: TcGlobals -> reqTy:TType -> TType +val changeWithNullReqTyToVariable: TcGlobals -> reqTy: TType -> TType -val reqTyForArgumentNullnessInference: TcGlobals -> actualTy:TType -> reqTy:TType -> TType +val reqTyForArgumentNullnessInference: TcGlobals -> actualTy: TType -> reqTy: TType -> TType val isFunTy: TcGlobals -> TType -> bool From 47659b19601e71d5f60f5c3dfb30d7628984c21c Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 31 May 2024 11:58:00 +0200 Subject: [PATCH 4/6] Documenting a specific case to be fixed - partial inference _ | null and passing it to a null-allowing API --- src/Compiler/TypedTree/TypedTreeOps.fs | 2 +- .../Language/NullableReferenceTypesTests.fs | 17 +++++++++++++++++ tests/adhoc/nullness/enabled/positive.fs | 8 ++++---- 3 files changed, 22 insertions(+), 5 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 81afbf17979..9bb87cfc5f8 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -9180,7 +9180,7 @@ let changeWithNullReqTyToVariable g reqTy = 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 -> + | ValueSome t when t.IsCompilerGenerated && not(t.Constraints |> List.exists(function | TyparConstraint.SupportsNull _ -> true | _ -> false))-> changeWithNullReqTyToVariable g reqTy | _ -> reqTy diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 9a5f666627a..9ee080928a7 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -32,9 +32,13 @@ let nonStrictFunc(x:string | null) = strictFunc(x) [] [] [] +[] [ fileExists")>] +[ fileExists")>] [] +[] [ System.IO.File.Exists")>] +[ System.IO.File.Exists")>] [] let ``Calling a nullAllowing API can still infer a withoutNull type``(functionCall) = FSharp $""" @@ -51,6 +55,19 @@ let myStringReturningFunc (path) = |> 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 $""" 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) From 5240ed3ff89b178be61983a2c28b34cdbbd2a6e3 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 10 Jun 2024 12:29:50 +0200 Subject: [PATCH 5/6] CI likes tests to be `compile` and not just `typecheck` --- .../Language/NullableReferenceTypesTests.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs index 9ee080928a7..0a409783185 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -14,7 +14,7 @@ let withNullnessOptions cu = let typeCheckWithStrictNullness cu = cu |> withNullnessOptions - |> typecheck + |> compile [] let ``Cannot pass possibly null value to a strict function``() = From 10cf11b37dfa56c5eedd5f90e14e3282fbc22175 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 10 Jun 2024 15:13:39 +0200 Subject: [PATCH 6/6] tests --- .../EmittedIL/Nullness/ReferenceDU.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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