From 69effd95e2ac076cf8cf9b7129af13a82f47fc4d Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 6 Feb 2024 12:57:20 +0100 Subject: [PATCH 1/2] Format string %s should allow nullable string --- src/Compiler/Checking/CheckFormatStrings.fs | 2 +- src/Compiler/TypedTree/TcGlobals.fs | 2 + .../FSharp.Compiler.ComponentTests.fsproj | 7 +- .../Language/NullableReferenceTypesTests.fs | 74 +++++++++++++++++++ 4 files changed, 81 insertions(+), 4 deletions(-) create mode 100644 tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs diff --git a/src/Compiler/Checking/CheckFormatStrings.fs b/src/Compiler/Checking/CheckFormatStrings.fs index ec8b4ae2b91..41ff31f1438 100644 --- a/src/Compiler/Checking/CheckFormatStrings.fs +++ b/src/Compiler/Checking/CheckFormatStrings.fs @@ -449,7 +449,7 @@ let parseFormatStringInternal checkOtherFlags ch collectSpecifierLocation fragLine fragCol 1 let i = skipPossibleInterpolationHole (i+1) - parseLoop ((posi, g.string_ty) :: acc) (i, fragLine, fragCol+1) fragments + parseLoop ((posi, g.string_ty_withNull) :: acc) (i, fragLine, fragCol+1) fragments | 'O' -> checkOtherFlags ch diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index cc67a69edab..946a9f5b2f1 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -447,6 +447,7 @@ type TcGlobals( let v_FormattableStringFactory_tcref = findSysTyconRef sysCompilerServices "FormattableStringFactory" let v_FormattableStringFactory_ty = mkNonGenericTy v_FormattableStringFactory_tcref let v_string_ty = mkNonGenericTy v_string_tcr + let v_string_ty_withNull = mkNonGenericTyWithNullness v_string_tcr KnownWithNull let v_decimal_ty = mkSysNonGenericTy sys "Decimal" let v_unit_ty = mkNonGenericTy v_unit_tcr_nice let v_system_Type_ty = mkSysNonGenericTy sys "Type" @@ -1336,6 +1337,7 @@ type TcGlobals( member _.bool_ty = v_bool_ty member _.int_ty = v_int_ty member _.string_ty = v_string_ty + member _.string_ty_withNull = v_string_ty_withNull member _.system_IFormattable_tcref = v_IFormattable_tcref member _.system_FormattableString_tcref = v_FormattableString_tcref member _.system_FormattableStringFactory_tcref = v_FormattableStringFactory_tcref diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 6fe69ad285a..a11357eda30 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -221,11 +221,12 @@ - - - + + + + diff --git a/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs new file mode 100644 index 00000000000..ff50d481185 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Language/NullableReferenceTypesTests.fs @@ -0,0 +1,74 @@ +module Language.NullableReferenceTypes + +open Xunit +open FSharp.Test.Compiler + +let typeCheckWithStrictNullness cu = + cu + |> withLangVersionPreview + |> withCheckNulls + |> withWarnOn 3261 + |> withOptions ["--warnaserror+"] + |> typecheck + +[] +let ``Printing a nullable string should pass`` () = + FSharp """module MyLibrary +let maybeNull : string | null = null +let nonNullString = "abc" +let printedValueNotNull = sprintf "This is not null: %s" nonNullString +let printedValueNull = sprintf "This is null: %s" maybeNull +let interpolated = $"This is fine {maybeNull}" +let interpolatedAnnotatedNotNull = $"This is fine %s{nonNullString}" +let interpolatedAnnotatedNullable = $"This is not null %s{maybeNull}" +let interpolateNullLiteral = $"This is not null %s{null}" +let sprintfnNullLiteral = sprintf "This is null: %s" null +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + + +[] +let ``Printing a nullable object should pass`` () = + FSharp """module MyLibrary +let maybeNull : string | null = null +let maybeUri : System.Uri | null = null +let okString = "abc" +let printViaO = sprintf "This is null: %O and this is null %O and this is not null %O" maybeNull maybeUri okString +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + + +[] +let ``Printing a nullable array via percent A should pass`` () = + FSharp """module MyLibrary +let maybeArray : ((string array) | null) = null +let arrayOfMaybes : ((string | null) array ) = [|null|] +let printViaA = sprintf "This is null: %A and this has null inside %A" maybeArray arrayOfMaybes +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + +[] +let ``WhatIf the format itself is null`` () = + FSharp """module MyLibrary +[] +let thisCannotBeAFormat : string | null = null +[] +let maybeLiteral : string | null = "abc" +[] +let maybeLiteralWithHole : string | null = "Look at me %s" +[] +let notNullLiteral : string = "abc" +let doStuff() = + printfn notNullLiteral + printfn maybeLiteral + printfn maybeLiteralWithHole thisCannotBeAFormat +""" + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed \ No newline at end of file From 1e93440886133724176cfd6726ca2a571e6b96a9 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 6 Feb 2024 13:36:22 +0100 Subject: [PATCH 2/2] This was affecting generated fsi, do not allow nulls if not needed --- src/Compiler/Checking/CheckFormatStrings.fs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Checking/CheckFormatStrings.fs b/src/Compiler/Checking/CheckFormatStrings.fs index 41ff31f1438..b37f21506a6 100644 --- a/src/Compiler/Checking/CheckFormatStrings.fs +++ b/src/Compiler/Checking/CheckFormatStrings.fs @@ -449,7 +449,8 @@ let parseFormatStringInternal checkOtherFlags ch collectSpecifierLocation fragLine fragCol 1 let i = skipPossibleInterpolationHole (i+1) - parseLoop ((posi, g.string_ty_withNull) :: acc) (i, fragLine, fragCol+1) fragments + let stringTy = if g.checkNullness && g.langFeatureNullness then g.string_ty_withNull else g.string_ty + parseLoop ((posi, stringTy) :: acc) (i, fragLine, fragCol+1) fragments | 'O' -> checkOtherFlags ch