Skip to content
Merged
Show file tree
Hide file tree
Changes from 4 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion docs/release-notes/.FSharp.Compiler.Service/8.0.300.md
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@
* Graph Based Checking doesn't throw on invalid parsed input so it can be used for IDE scenarios ([PR #16575](https://github.com/dotnet/fsharp/pull/16575), [PR #16588](https://github.com/dotnet/fsharp/pull/16588), [PR #16643](https://github.com/dotnet/fsharp/pull/16643))
* Keep parens for problematic exprs (`if`, `match`, etc.) in `$"{(…):N0}"`, `$"{(…),-3}"`, etc. ([PR #16578](https://github.com/dotnet/fsharp/pull/16578))
* Fix crash in DOTNET_SYSTEM_GLOBALIZATION_INVARIANT mode [#PR 16471](https://github.com/dotnet/fsharp/pull/16471))

* Fix16572 - Fixed the preview feature enabling Is properties for union case did not work correctly with let rec and .fsi files ([PR #16657](https://github.com/dotnet/fsharp/pull/16657))

### Added

Expand Down
34 changes: 18 additions & 16 deletions src/Compiler/Checking/CheckDeclarations.fs
Original file line number Diff line number Diff line change
Expand Up @@ -4727,7 +4727,6 @@ module TcDeclarations =
let env = List.foldBack (AddLocalVal g cenv.tcSink scopem) idvs envForDecls
env)


/// Bind a collection of mutually recursive declarations in a signature file
let TcMutRecSignatureDecls (cenv: cenv) envInitial parent typeNames tpenv m scopem mutRecNSInfo (mutRecSigs: MutRecSigsInitialData) =
let mutRecSigsAfterSplit = mutRecSigs |> MutRecShapes.mapTycons SplitTyconSignature
Expand All @@ -4739,6 +4738,18 @@ module TcDeclarations =
// Updates the types of the modules to contain the contents so far, which now includes values and members
MutRecBindingChecking.TcMutRecDefns_UpdateModuleContents mutRecNSInfo mutRecDefnsAfterCore

// Generate the union augmentation values for all tycons.
let mutable vals = List.empty
(envMutRec, mutRecDefnsAfterCore)
||> MutRecShapes.iterTyconsWithEnv (fun envForDecls ((tyconCore, _, _), tyconOpt, _, _, _) ->
let (MutRecDefnsPhase1DataForTycon (isAtOriginalTyconDefn=isAtOriginalTyconDefn)) = tyconCore
match tyconOpt with
| Some tycon when isAtOriginalTyconDefn ->
if tycon.IsUnionTycon && AddAugmentationDeclarations.ShouldAugmentUnion cenv.g tycon then
let vspecs = AddAugmentationDeclarations.AddUnionAugmentationValues cenv envForDecls tycon
vals <- vspecs @ vals
| _ -> ())

// By now we've established the full contents of type definitions apart from their
// members and any fields determined by implicit construction. We know the kinds and
// representations of types and have established them as valid.
Expand All @@ -4747,28 +4758,19 @@ module TcDeclarations =
//
// Note: This environment reconstruction doesn't seem necessary. We're about to create Val's for all members,
// which does require type checking, but no more information than is already available.
let envMutRecPrelimWithReprs, withEnvs =

let envMutRecPrelimWithReprs, withEnvs =
(envInitial, MutRecShapes.dropEnvs mutRecDefnsAfterCore)
||> MutRecBindingChecking.TcMutRecDefns_ComputeEnvs
(fun (_, tyconOpt, _, _, _) -> tyconOpt)
(fun _binds -> [ (* no values are available yet *) ])
cenv true scopem m
||> MutRecBindingChecking.TcMutRecDefns_ComputeEnvs
(fun (_, tyconOpt, _, _, _) -> tyconOpt)
(fun _binds -> vals)
cenv true scopem m

let mutRecDefnsAfterVals = TcMutRecSignatureDecls_Phase2 cenv scopem envMutRecPrelimWithReprs withEnvs

// Updates the types of the modules to contain the contents so far, which now includes values and members
MutRecBindingChecking.TcMutRecDefns_UpdateModuleContents mutRecNSInfo mutRecDefnsAfterVals

// Generate the union augmentation values for all tycons.
(envMutRec, mutRecDefnsAfterCore) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls ((tyconCore, _, _), tyconOpt, _, _, _) ->
let (MutRecDefnsPhase1DataForTycon (isAtOriginalTyconDefn=isAtOriginalTyconDefn)) = tyconCore
match tyconOpt with
| Some tycon when isAtOriginalTyconDefn ->
if tycon.IsUnionTycon && AddAugmentationDeclarations.ShouldAugmentUnion cenv.g tycon then
let vspecs = AddAugmentationDeclarations.AddUnionAugmentationValues cenv envForDecls tycon
ignore vspecs
| _ -> ())

envMutRec

//-------------------------------------------------------------------------
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -609,3 +609,64 @@ module UnionTypes =
|> withDiagnostics [
(Warning 42, Line 11, Col 12, Line 11, Col 24, "This construct is deprecated: it is only for use in the F# library")
]

[<Theory>]
[<InlineData(false)>]
[<InlineData(true)>]
let ``UnionCaseIsTester inlined and SignatureData`` userec =

let kwrec = if userec then "rec" else ""
let myLibraryFsi =
SourceCodeFileKind.Create(
"myLibrary.fsi",
$"""
module {kwrec} MyLibrary

[<RequireQualifiedAccess>]
type PrimaryAssembly =
| Mscorlib
| System_Runtime
| NetStandard""")

let myLibraryFs =
SourceCodeFileKind.Create(
"myLibrary.fs",
$"""
module {kwrec} MyLibrary

[<RequireQualifiedAccess>]
type PrimaryAssembly =
| Mscorlib
| System_Runtime
| NetStandard
""")

let myFileFs =
SourceCodeFileKind.Create(
"myFile.fs",
$"""
module {kwrec} FileName

open MyLibrary
let inline getAssemblyType () = PrimaryAssembly.NetStandard
let inline isNetStandard () = (PrimaryAssembly.NetStandard).IsNetStandard
""")

let myLibrary =
(fsFromString myLibraryFsi) |> FS
|> withAdditionalSourceFiles [myLibraryFs; myFileFs]
|> asLibrary
|> withLangVersionPreview
|> withName "MyLibrary"

Fs """
let x = FileName.getAssemblyType().IsNetStandard
let y = FileName.getAssemblyType()
let z = FileName.isNetStandard()
printfn "%b %A %b" x y z
"""
|> asExe
|> withReferences [myLibrary]
|> withLangVersionPreview
|> compileAndRun
|> shouldSucceed
Original file line number Diff line number Diff line change
Expand Up @@ -2,10 +2,12 @@

namespace Language

open Xunit
open FSharp.Test.Compiler

module DiscriminatedUnionTests =
[<FSharp.Test.FactForNETCOREAPP>]

[<Fact>]
let ``Simple Is* discriminated union properties are visible, proper values are returned`` () =
Fsx """
type Foo = | Foo of string | Bar
Expand All @@ -17,7 +19,7 @@ if foo.IsBar then failwith "Should not be Bar"
|> compileExeAndRun
|> shouldSucceed

[<FSharp.Test.FactForNETCOREAPP>]
[<Fact>]
let ``Simple Is* discriminated union properties are not visible for a single case union`` () =
Fsx """
type Foo = Bar of string
Expand All @@ -31,7 +33,7 @@ if not foo.IsBar then failwith "Should be Bar"
|> withDiagnostics [Error 39, Line 4, Col 12, Line 4, Col 17, "The type 'Foo' does not define the field, constructor or member 'IsBar'. Maybe you want one of the following:
Bar"]

[<FSharp.Test.FactForNETCOREAPP>]
[<Fact>]
let ``Simple Is* discriminated union property satisfies SRTP constraint`` () =
Fsx """
type X =
Expand All @@ -47,7 +49,7 @@ X.A "a" |> test
|> compileExeAndRun
|> shouldSucceed

[<FSharp.Test.FactForNETCOREAPP>]
[<Fact>]
let ``Lowercase Is* discriminated union properties are visible, proper values are returned`` () =
Fsx """
[<RequireQualifiedAccess>]
Expand All @@ -63,7 +65,7 @@ if foo.IsA then failwith "Should not be A"
|> compileExeAndRun
|> shouldSucceed

[<FSharp.Test.FactForNETCOREAPP>]
[<Fact>]
let ``Is* discriminated union properties with backticks are visible, proper values are returned`` () =
Fsx """
type Foo = | Foo of string | ``Mars Bar``
Expand All @@ -79,7 +81,7 @@ if not marsbar.``IsMars Bar`` then failwith "Should be ``Mars Bar``"
|> compileExeAndRun
|> shouldSucceed

[<FSharp.Test.FactForNETCOREAPP>]
[<Fact>]
let ``Is* discriminated union properties are visible, proper values are returned in recursive namespace, before the definition`` () =
FSharp """
namespace rec Hello
Expand All @@ -102,7 +104,7 @@ type Foo =
|> shouldSucceed


[<FSharp.Test.FactForNETCOREAPP>]
[<Fact>]
let ``Is* discriminated union properties are visible, proper values are returned in recursive namespace, in SRTP`` () =
FSharp """
namespace Hello
Expand Down Expand Up @@ -130,7 +132,7 @@ module Main =
|> compileExeAndRun
|> shouldSucceed

[<FSharp.Test.FactForNETCOREAPP>]
[<Fact>]
let ``Is* discriminated union properties are unavailable with DefaultAugmentation(false)`` () =
Fsx """
[<DefaultAugmentation(false)>]
Expand All @@ -144,19 +146,40 @@ let isFoo = foo.IsFoo
|> withErrorMessage "The type 'Foo' does not define the field, constructor or member 'IsFoo'. Maybe you want one of the following:
Foo"

[<FSharp.Test.FactForNETCOREAPP>]
let ``Is* discriminated union properties are unavailable on voption`` () =
[<Fact>]
let ``Is* discriminated union properties are unavailable on union case with lang version 8`` () =
Fsx """
let x = (ValueSome 1).IsSome
let y = ValueOption<int>.None.IsValueNone
[<RequireQualifiedAccess>]
type PrimaryAssembly =
| Mscorlib
| System_Runtime
| NetStandard

let x = (PrimaryAssembly.Mscorlib).IsMscorlib
"""
|> withLangVersionPreview
|> withLangVersion80
|> typecheck
|> shouldFail
|> withErrorMessage "The type 'ValueOption<_>' does not define the field, constructor or member 'IsValueNone'. Maybe you want one of the following:
ValueNone"
|> withErrorMessage "The type 'PrimaryAssembly' does not define the field, constructor or member 'IsMscorlib'. Maybe you want one of the following:
Mscorlib"


[<Fact>]
let ``Is* discriminated union properties are available on union case after lang version 8`` () =
Fsx """
[<RequireQualifiedAccess>]
type PrimaryAssembly =
| Mscorlib
| System_Runtime
| NetStandard

let x = (PrimaryAssembly.Mscorlib).IsMscorlib
"""
|> withLangVersionPreview
|> compileExeAndRun
|> shouldSucceed

[<FSharp.Test.FactForNETCOREAPP>]
[<Fact>]
let ``Is* discriminated union properties work with UseNullAsTrueValue`` () =
Fsx """
[<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
Expand Down