MultipleRecordTypeChoiceExtendedData stuff

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 ->

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 =
 

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)
 

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."

src/Compiler/FSStrings.resx

@@ -1116,6 +1116,9 @@
   <data name="ArgumentsInSigAndImplMismatch" xml:space="preserve">
     <value>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.</value>
   </data>
+  <data name="MultipleRecordTypeChoice" xml:space="preserve">
+    <value>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.</value>
+  </data>
   <data name="Parser.TOKEN.WHILE.BANG" xml:space="preserve">
     <value>keyword 'while!'</value>
   </data>

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
+[<Class; Experimental("This FCS API is experimental and subject to change.")>]
+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 =

src/Compiler/Symbols/FSharpDiagnostic.fsi

@@ -100,6 +100,14 @@ type ArgumentsInSigAndImplMismatchExtendedData =
     /// Argument identifier range within implementation file
     member ImplementationRange: range
 
+/// Stuff for MultipleRecordTypeChoice
+[<Class; Experimental("This FCS API is experimental and subject to change.")>]
+type MultipleRecordTypeChoiceExtendedData =
+    interface IFSharpDiagnosticExtendedData
+    member ResolvedType: FSharpEntity
+    member Candidates: FSharpEntity list
+    member OverlappingMembers: string list
+
 /// Represents a diagnostic produced by the F# compiler
 [<Class>]
 type public FSharpDiagnostic =