diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs
index 292343dd223..836e4bc6655 100644
--- a/src/Compiler/Checking/NameResolution.fs
+++ b/src/Compiler/Checking/NameResolution.fs
@@ -34,6 +34,8 @@ open FSharp.Compiler.TypedTreeBasics
open FSharp.Compiler.TypedTreeOps
open FSharp.Compiler.TypeHierarchy
+exception MultipleRecordTypeChoice of g: TcGlobals * candidates: TyconRef list * resolvedType: TyconRef * overlappingNames: string list * range: range
+
#if !NO_TYPEPROVIDERS
open FSharp.Compiler.TypeProviders
#endif
@@ -2719,22 +2721,32 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf
let intersect = Set.intersect fieldsOfAlternatives fieldsOfResolvedType
if not intersect.IsEmpty then
- let resolvedTypeName = NicePrint.fqnOfEntityRef g tcref
- let namesOfAlternatives =
- fieldLabels
- |> List.map (fun l -> $" %s{NicePrint.fqnOfEntityRef g l.TyconRef}")
- |> fun names -> $" %s{resolvedTypeName}" :: names
- let candidates = System.String.Join("\n", namesOfAlternatives)
- let overlappingNames =
- intersect
- |> Set.toArray
- |> Array.sort
- |> Array.map (fun s -> $" %s{s}")
- |> fun a -> System.String.Join("\n", a)
+ // let resolvedTypeName = NicePrint.fqnOfEntityRef g tcref
+
+
if g.langVersion.SupportsFeature(LanguageFeature.WarningWhenMultipleRecdTypeChoice) then
- warning(Error(FSComp.SR.tcMultipleRecdTypeChoice(candidates, resolvedTypeName, overlappingNames), m))
+ let candidates = fieldLabels |> List.map (fun l -> l.TyconRef)
+ let overlappingNames =
+ intersect
+ |> Set.toList
+ |> List.sort
+ warning(MultipleRecordTypeChoice(g, candidates, tcref, overlappingNames, m))
+ // warning(Error(FSComp.SR.tcMultipleRecdTypeChoice(candidates, resolvedTypeName, overlappingNames), m))
else
- informationalWarning(Error(FSComp.SR.tcMultipleRecdTypeChoice(candidates, resolvedTypeName, overlappingNames), m))
+ failwith "Yeah this part doesn't work anymore"
+ // let resolvedTypeName = NicePrint.fqnOfEntityRef g tcref
+ // let namesOfAlternatives =
+ // fieldLabels
+ // |> List.map (fun l -> $" %s{NicePrint.fqnOfEntityRef g l.TyconRef}")
+ // |> fun names -> $" %s{resolvedTypeName}" :: names
+ // let candidates = System.String.Join("\n", namesOfAlternatives)
+ // let overlappingNames =
+ // intersect
+ // |> Set.toArray
+ // |> Array.sort
+ // |> Array.map (fun s -> $" %s{s}")
+ // |> fun a -> System.String.Join("\n", a)
+ // informationalWarning(Error(FSComp.SR.tcMultipleRecdTypeChoice(candidates, resolvedTypeName, overlappingNames), m))
| _ -> ()
FSComp.SR.undefinedNameFieldConstructorOrMemberWhenTypeIsKnown(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars, s)
| ValueSome tcref ->
diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi
index 5dcc55efc94..7d9f44c0036 100755
--- a/src/Compiler/Checking/NameResolution.fsi
+++ b/src/Compiler/Checking/NameResolution.fsi
@@ -14,6 +14,8 @@ open FSharp.Compiler.TypedTree
open FSharp.Compiler.TypedTreeOps
open FSharp.Compiler.TcGlobals
+exception MultipleRecordTypeChoice of g: TcGlobals * candidates: TyconRef list * resolvedType: TyconRef * overlappingNames: string list * range: range
+
/// A NameResolver is a context for name resolution. It primarily holds an InfoReader.
type NameResolver =
diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs
index 0ec2a8ce98b..67c6ab462b0 100644
--- a/src/Compiler/Driver/CompilerDiagnostics.fs
+++ b/src/Compiler/Driver/CompilerDiagnostics.fs
@@ -80,6 +80,7 @@ type Exception with
member exn.DiagnosticRange =
match exn with
| ArgumentsInSigAndImplMismatch (_, implArg) -> Some implArg.idRange
+ | MultipleRecordTypeChoice(range = m) -> Some m
| ErrorFromAddingConstraint (_, exn2, _) -> exn2.DiagnosticRange
#if !NO_TYPEPROVIDERS
| TypeProviders.ProvidedTypeResolutionNoRange exn -> exn.DiagnosticRange
@@ -321,6 +322,7 @@ type Exception with
| HashLoadedScriptConsideredSource _ -> 92
| UnresolvedConversionOperator _ -> 93
| ArgumentsInSigAndImplMismatch _ -> 3218
+ | MultipleRecordTypeChoice _ -> 3566
// avoid 94-100 for safety
| ObsoleteError _ -> 101
#if !NO_TYPEPROVIDERS
@@ -603,6 +605,7 @@ module OldStyleMessages =
let MSBuildReferenceResolutionErrorE () = Message("MSBuildReferenceResolutionError", "%s%s")
let TargetInvocationExceptionWrapperE () = Message("TargetInvocationExceptionWrapper", "%s")
let ArgumentsInSigAndImplMismatchE () = Message("ArgumentsInSigAndImplMismatch", "%s%s")
+ let MultipleRecordTypeChoiceE () = Message("MultipleRecordTypeChoice", "%s%s%s")
#if DEBUG
let mutable showParserStackOnParseError = false
@@ -1876,6 +1879,19 @@ type Exception with
| ArgumentsInSigAndImplMismatch (sigArg, implArg) ->
os.AppendString(ArgumentsInSigAndImplMismatchE().Format sigArg.idText implArg.idText)
+ | MultipleRecordTypeChoice(g, candidates, resolvedType, overlappingNames, _) ->
+ let resolvedTypeName = NicePrint.fqnOfEntityRef g resolvedType
+ let namesOfAlternatives =
+ candidates
+ |> List.map (fun c -> $" %s{NicePrint.fqnOfEntityRef g c}")
+ |> fun names -> $" %s{resolvedTypeName}" :: names
+ let candidates = System.String.Join("\n", namesOfAlternatives)
+ let overlappingNames =
+ overlappingNames
+ |> List.map (fun s -> $" %s{s}")
+ |> String.concat "\n"
+ os.AppendString(MultipleRecordTypeChoiceE().Format candidates resolvedTypeName overlappingNames)
+
// Strip TargetInvocationException wrappers
| :? TargetInvocationException as exn -> exn.InnerException.Output(os, suggestNames)
diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt
index 9f091d07533..9e7226733e2 100644
--- a/src/Compiler/FSComp.txt
+++ b/src/Compiler/FSComp.txt
@@ -1709,7 +1709,6 @@ featureEscapeBracesInFormattableString,"Escapes curly braces before calling Form
3565,parsExpectingType,"Expecting type"
featureInformationalObjInferenceDiagnostic,"Diagnostic 3559 (warn when obj inferred) at informational level, off by default"
featureStaticLetInRecordsDusEmptyTypes,"Allow static let bindings in union, record, struct, non-incremental-class types"
-3566,tcMultipleRecdTypeChoice,"Multiple type matches were found:\n%s\nThe type '%s' was used. Due to the overlapping field names\n%s\nconsider using type annotations or change the order of open statements."
3567,parsMissingMemberBody,"Expecting member body"
3568,parsMissingKeyword,"Missing keyword '%s'"
3569,chkNotTailRecursive,"The member or function '%s' has the 'TailCallAttribute' attribute, but is not being used in a tail recursive way."
diff --git a/src/Compiler/FSStrings.resx b/src/Compiler/FSStrings.resx
index 04946671a84..2ea6d9be616 100644
--- a/src/Compiler/FSStrings.resx
+++ b/src/Compiler/FSStrings.resx
@@ -1116,6 +1116,9 @@
The argument names in the signature '{0}' and implementation '{1}' do not match. The argument name from the signature file will be used. This may cause problems when debugging or profiling.
+
+ Multiple type matches were found:\n{0}\nThe type '{1}' was used. Due to the overlapping field names\n{2}\nconsider using type annotations or change the order of open statements.
+
keyword 'while!'
diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fs b/src/Compiler/Symbols/FSharpDiagnostic.fs
index 00b3197a554..3bc0d9546b5 100644
--- a/src/Compiler/Symbols/FSharpDiagnostic.fs
+++ b/src/Compiler/Symbols/FSharpDiagnostic.fs
@@ -22,6 +22,7 @@ open Internal.Utilities.Library.Extras
open FSharp.Core.Printf
open FSharp.Compiler
+open FSharp.Compiler.NameResolution
open FSharp.Compiler.CompilerDiagnostics
open FSharp.Compiler.Diagnostics
open FSharp.Compiler.DiagnosticsLogger
@@ -106,6 +107,15 @@ type ArgumentsInSigAndImplMismatchExtendedData
member x.SignatureRange = sigArg.idRange
member x.ImplementationRange = implArg.idRange
+/// Stuff for MultipleRecordTypeChoice
+[]
+type MultipleRecordTypeChoiceExtendedData
+ internal (resolvedType, candidates, overlappingMembers) =
+ interface IFSharpDiagnosticExtendedData
+ member _.ResolvedType: FSharpEntity = resolvedType
+ member _.Candidates: FSharpEntity list = candidates
+ member _.OverlappingMembers: string list = overlappingMembers
+
type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: string, subcategory: string, errorNum: int, numberPrefix: string, extendedData: IFSharpDiagnosticExtendedData option) =
member _.Range = m
@@ -188,6 +198,11 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str
| ArgumentsInSigAndImplMismatch(sigArg, implArg) ->
Some(ArgumentsInSigAndImplMismatchExtendedData(sigArg, implArg))
+ | MultipleRecordTypeChoice(_, candidates, resolvedType, overlappingNames, _) ->
+ let rt = FSharpEntity(symbolEnv, resolvedType)
+ let c = candidates |> List.map (fun c -> FSharpEntity(symbolEnv, c))
+ Some (MultipleRecordTypeChoiceExtendedData(rt, c, overlappingNames))
+
| _ -> None
let msg =
diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fsi b/src/Compiler/Symbols/FSharpDiagnostic.fsi
index 9449e31b182..9db2697eaf7 100644
--- a/src/Compiler/Symbols/FSharpDiagnostic.fsi
+++ b/src/Compiler/Symbols/FSharpDiagnostic.fsi
@@ -100,6 +100,14 @@ type ArgumentsInSigAndImplMismatchExtendedData =
/// Argument identifier range within implementation file
member ImplementationRange: range
+/// Stuff for MultipleRecordTypeChoice
+[]
+type MultipleRecordTypeChoiceExtendedData =
+ interface IFSharpDiagnosticExtendedData
+ member ResolvedType: FSharpEntity
+ member Candidates: FSharpEntity list
+ member OverlappingMembers: string list
+
/// Represents a diagnostic produced by the F# compiler
[]
type public FSharpDiagnostic =