Add ExtendedData to FSharpDiagnostic

src/Compiler/Checking/SignatureConformance.fsi

@@ -7,6 +7,7 @@ module internal FSharp.Compiler.SignatureConformance
 open System.Text
 
 open FSharp.Compiler
+open FSharp.Compiler.Syntax
 open FSharp.Compiler.Text
 open FSharp.Compiler.TypedTree
 open FSharp.Compiler.TypedTreeOps
@@ -26,10 +27,19 @@ exception UnionCaseNotContained of DisplayEnv * InfoReader * Tycon * UnionCase *
 
 exception FSharpExceptionNotContained of DisplayEnv * InfoReader * Tycon * Tycon * (string * string -> string)
 
-exception FieldNotContained of DisplayEnv * InfoReader * Tycon * RecdField * RecdField * (string * string -> string)
+exception FieldNotContained of
+    DisplayEnv *
+    InfoReader *
+    Tycon *
+    Tycon *
+    RecdField *
+    RecdField *
+    (string * string -> string)
 
 exception InterfaceNotRevealed of DisplayEnv * TType * range
 
+exception ArgumentsInSigAndImplMismatch of sigArg: Ident * implArg: Ident
+
 type Checker =
 
     new:

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -79,6 +79,7 @@ type Exception with
 
     member exn.DiagnosticRange =
         match exn with
+        | ArgumentsInSigAndImplMismatch (_, implArg) -> Some implArg.idRange
         | ErrorFromAddingConstraint (_, exn2, _) -> exn2.DiagnosticRange
 #if !NO_TYPEPROVIDERS
         | TypeProviders.ProvidedTypeResolutionNoRange exn -> exn.DiagnosticRange
@@ -157,7 +158,7 @@ type Exception with
         | IndeterminateType m
         | TyconBadArgs (_, _, _, m) -> Some m
 
-        | FieldNotContained (_, _, _, arf, _, _) -> Some arf.Range
+        | FieldNotContained (_, _, _, _, arf, _, _) -> Some arf.Range
         | ValueNotContained (_, _, _, aval, _, _) -> Some aval.Range
         | UnionCaseNotContained (_, _, _, aval, _, _) -> Some aval.Id.idRange
         | FSharpExceptionNotContained (_, _, aexnc, _, _) -> Some aexnc.Range
@@ -319,6 +320,7 @@ type Exception with
         | BadEventTransformation _ -> 91
         | HashLoadedScriptConsideredSource _ -> 92
         | UnresolvedConversionOperator _ -> 93
+        | ArgumentsInSigAndImplMismatch _ -> 3218
         // avoid 94-100 for safety
         | ObsoleteError _ -> 101
 #if !NO_TYPEPROVIDERS
@@ -600,6 +602,7 @@ module OldStyleMessages =
     let LoadedSourceNotFoundIgnoringE () = Message("LoadedSourceNotFoundIgnoring", "%s")
     let MSBuildReferenceResolutionErrorE () = Message("MSBuildReferenceResolutionError", "%s%s")
     let TargetInvocationExceptionWrapperE () = Message("TargetInvocationExceptionWrapper", "%s")
+    let ArgumentsInSigAndImplMismatchE () = Message("ArgumentsInSigAndImplMismatch", "%s%s")
 
 #if DEBUG
 let mutable showParserStackOnParseError = false
@@ -1571,7 +1574,7 @@ type Exception with
                 )
             )
 
-        | FieldNotContained (denv, infoReader, enclosingTycon, v1, v2, f) ->
+        | FieldNotContained (denv, infoReader, enclosingTycon, _, v1, v2, f) ->
             let enclosingTcref = mkLocalEntityRef enclosingTycon
 
             os.AppendString(
@@ -1870,6 +1873,9 @@ type Exception with
 
         | MSBuildReferenceResolutionError (code, message, _) -> os.AppendString(MSBuildReferenceResolutionErrorE().Format message code)
 
+        | ArgumentsInSigAndImplMismatch (sigArg, implArg) ->
+            os.AppendString(ArgumentsInSigAndImplMismatchE().Format sigArg.idText implArg.idText)
+
         // Strip TargetInvocationException wrappers
         | :? TargetInvocationException as exn -> exn.InnerException.Output(os, suggestNames)
 

src/Compiler/FSComp.txt

@@ -1491,7 +1491,6 @@ notAFunctionButMaybeIndexerWithName2,"This value is not a function and cannot be
 notAFunctionButMaybeIndexer2,"This expression is not a function and cannot be applied. Did you intend to access the indexer via 'expr[index]'?"
 3217,notAFunctionButMaybeIndexerErrorCode,""
 notAFunctionButMaybeDeclaration,"This value is not a function and cannot be applied. Did you forget to terminate a declaration?"
-3218,ArgumentsInSigAndImplMismatch,"The argument names in the signature '%s' and implementation '%s' do not match. The argument name from the signature file will be used. This may cause problems when debugging or profiling."
 3219,pickleUnexpectedNonZero,"An error occurred while reading the F# metadata of assembly '%s'. A reserved construct was utilized. You may need to upgrade your F# compiler or use an earlier version of the assembly that doesn't make use of a specific construct."
 3220,tcTupleMemberNotNormallyUsed,"This method or property is not normally used from F# code, use an explicit tuple pattern for deconstruction instead."
 3221,implicitlyDiscardedInSequenceExpression,"This expression returns a value of type '%s' but is implicitly discarded. Consider using 'let' to bind the result to a name, e.g. 'let result = expression'. If you intended to use the expression as a value in the sequence then use an explicit 'yield'."

src/Compiler/FSStrings.resx

@@ -1113,6 +1113,9 @@
   <data name="ErrorFromAddingTypeEquationTuples" xml:space="preserve">
     <value>Type mismatch. Expecting a tuple of length {0} of type\n    {1}    \nbut given a tuple of length {2} of type\n    {3}    {4}\n</value>
   </data>
+  <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="Parser.TOKEN.WHILE.BANG" xml:space="preserve">
     <value>keyword 'while!'</value>
   </data>

src/Compiler/FSharp.Compiler.Service.fsproj

@@ -440,12 +440,12 @@
     <Compile Include="Driver\fsc.fs" />
 
     <!-- the symbol API. -->
-    <Compile Include="Symbols\FSharpDiagnostic.fsi" />
-    <Compile Include="Symbols\FSharpDiagnostic.fs" />
     <Compile Include="Symbols\SymbolHelpers.fsi" />
     <Compile Include="Symbols\SymbolHelpers.fs" />
     <Compile Include="Symbols\Symbols.fsi" />
     <Compile Include="Symbols\Symbols.fs" />
+    <Compile Include="Symbols\FSharpDiagnostic.fsi" />
+    <Compile Include="Symbols\FSharpDiagnostic.fs" />
     <Compile Include="Symbols\Exprs.fsi" />
     <Compile Include="Symbols\Exprs.fs" />
     <Compile Include="Symbols\SymbolPatterns.fsi" />

src/Compiler/Interactive/fsi.fs

@@ -4703,7 +4703,7 @@ type FsiEvaluationSession
         let errs = diagnosticsLogger.GetDiagnostics()
 
         let errorInfos =
-            DiagnosticHelpers.CreateDiagnostics(errorOptions, true, scriptFile, errs, true, tcConfigB.flatErrors)
+            DiagnosticHelpers.CreateDiagnostics(errorOptions, true, scriptFile, errs, true, tcConfigB.flatErrors, None)
 
         let userRes =
             match res with

src/Compiler/Service/FSharpCheckerResults.fs

@@ -2442,21 +2442,16 @@ module internal ParseAndCheckFile =
         let fileInfo = sourceText.GetLastCharacterPosition()
 
         let collectOne severity diagnostic =
-            for diagnostic in
-                DiagnosticHelpers.ReportDiagnostic(
-                    options,
-                    false,
-                    mainInputFileName,
-                    fileInfo,
-                    diagnostic,
-                    severity,
-                    suggestNamesForErrors,
-                    flatErrors
-                ) do
-                diagnosticsCollector.Add diagnostic
+            // 1. Extended diagnostic data should be created after typechecking because it requires a valid SymbolEnv
+            // 2. Diagnostic message should be created during the diagnostic sink, because after typechecking
+            //    the formatting of types in it may change (for example, 'a to obj)
+            //
+            // So we'll create a diagnostic later, but cache the FormatCore message now
+            diagnostic.Exception.Data[ "CachedFormatCore" ] <- diagnostic.FormatCore(flatErrors, suggestNamesForErrors)
+            diagnosticsCollector.Add(struct (diagnostic, severity))
 
-                if severity = FSharpDiagnosticSeverity.Error then
-                    errorCount <- errorCount + 1
+            if severity = FSharpDiagnosticSeverity.Error then
+                errorCount <- errorCount + 1
 
         // This function gets called whenever an error happens during parsing or checking
         let diagnosticSink severity (diagnostic: PhasedDiagnostic) =
@@ -2495,15 +2490,30 @@ module internal ParseAndCheckFile =
         // Public members
         member _.DiagnosticsLogger = diagnosticsLogger
 
-        member _.CollectedDiagnostics = diagnosticsCollector.ToArray()
-
         member _.ErrorCount = errorCount
 
         member _.DiagnosticOptions
             with set opts = options <- opts
 
         member _.AnyErrors = errorCount > 0
 
+        member _.CollectedDiagnostics(symbolEnv: SymbolEnv option) =
+            [|
+                for struct (diagnostic, severity) in diagnosticsCollector do
+                    yield!
+                        DiagnosticHelpers.ReportDiagnostic(
+                            options,
+                            false,
+                            mainInputFileName,
+                            fileInfo,
+                            diagnostic,
+                            severity,
+                            suggestNamesForErrors,
+                            flatErrors,
+                            symbolEnv
+                        )
+            |]
+
     let getLightSyntaxStatus fileName options =
         let indentationAwareSyntaxOnByDefault =
             List.exists (FileSystemUtils.checkSuffix fileName) FSharpIndentationAwareSyntaxFileSuffixes
@@ -2713,7 +2723,7 @@ module internal ParseAndCheckFile =
                     errHandler.DiagnosticsLogger.StopProcessingRecovery e range0 // don't re-raise any exceptions, we must return None.
                     EmptyParsedInput(fileName, (isLastCompiland, isExe)))
 
-        errHandler.CollectedDiagnostics, parseResult, errHandler.AnyErrors
+        errHandler.CollectedDiagnostics(None), parseResult, errHandler.AnyErrors
 
     let ApplyLoadClosure
         (
@@ -2915,28 +2925,29 @@ module internal ParseAndCheckFile =
                         return ((tcState.TcEnvFromSignatures, EmptyTopAttrs, [], [ mty ]), tcState)
                 }
 
-            let errors = errHandler.CollectedDiagnostics
+            let (tcEnvAtEnd, _, implFiles, ccuSigsForFiles), tcState = resOpt
+
+            let symbolEnv = SymbolEnv(tcGlobals, tcState.Ccu, Some tcState.CcuSig, tcImports)
+            let errors = errHandler.CollectedDiagnostics(Some symbolEnv)
 
             let res =
-                match resOpt with
-                | (tcEnvAtEnd, _, implFiles, ccuSigsForFiles), tcState ->
-                    TypeCheckInfo(
-                        tcConfig,
-                        tcGlobals,
-                        List.head ccuSigsForFiles,
-                        tcState.Ccu,
-                        tcImports,
-                        tcEnvAtEnd.AccessRights,
-                        projectFileName,
-                        mainInputFileName,
-                        projectOptions,
-                        sink.GetResolutions(),
-                        sink.GetSymbolUses(),
-                        tcEnvAtEnd.NameEnv,
-                        loadClosure,
-                        List.tryHead implFiles,
-                        sink.GetOpenDeclarations()
-                    )
+                TypeCheckInfo(
+                    tcConfig,
+                    tcGlobals,
+                    List.head ccuSigsForFiles,
+                    tcState.Ccu,
+                    tcImports,
+                    tcEnvAtEnd.AccessRights,
+                    projectFileName,
+                    mainInputFileName,
+                    projectOptions,
+                    sink.GetResolutions(),
+                    sink.GetSymbolUses(),
+                    tcEnvAtEnd.NameEnv,
+                    loadClosure,
+                    List.tryHead implFiles,
+                    sink.GetOpenDeclarations()
+                )
 
             return errors, res
         }

src/Compiler/Service/IncrementalBuild.fs

@@ -1642,7 +1642,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc
                     Array.ofList delayedLogger.Diagnostics, false
             diagnostics
             |> Array.map (fun (diagnostic, severity) ->
-                FSharpDiagnostic.CreateFromException(diagnostic, severity, range.Zero, suggestNamesForErrors, flatErrors))
+                FSharpDiagnostic.CreateFromException(diagnostic, severity, range.Zero, suggestNamesForErrors, flatErrors, None))
 
         return builderOpt, diagnostics
-      }
+      }

src/Compiler/Service/service.fs

@@ -106,7 +106,7 @@ module CompileHelpers =
             { new DiagnosticsLogger("CompileAPI") with
 
                 member _.DiagnosticSink(diag, isError) =
-                    diagnostics.Add(FSharpDiagnostic.CreateFromException(diag, isError, range0, true, flatErrors)) // Suggest names for errors
+                    diagnostics.Add(FSharpDiagnostic.CreateFromException(diag, isError, range0, true, flatErrors, None)) // Suggest names for errors
 
                 member _.ErrorCount =
                     diagnostics
@@ -556,7 +556,8 @@ type BackgroundCompiler
                         fileName,
                         parseDiagnostics,
                         suggestNamesForErrors,
-                        builder.TcConfig.flatErrors
+                        builder.TcConfig.flatErrors,
+                        None
                     )
 
                 let diagnostics = [| yield! creationDiags; yield! parseDiagnostics |]
@@ -857,14 +858,19 @@ type BackgroundCompiler
                 let tcDiagnostics = tcInfo.TcDiagnostics
                 let diagnosticsOptions = builder.TcConfig.diagnosticsOptions
 
+                let symbolEnv =
+                    SymbolEnv(tcProj.TcGlobals, tcInfo.tcState.Ccu, Some tcInfo.tcState.CcuSig, tcProj.TcImports)
+                    |> Some
+
                 let parseDiagnostics =
                     DiagnosticHelpers.CreateDiagnostics(
                         diagnosticsOptions,
                         false,
                         fileName,
                         parseDiagnostics,
                         suggestNamesForErrors,
-                        builder.TcConfig.flatErrors
+                        builder.TcConfig.flatErrors,
+                        None
                     )
 
                 let parseDiagnostics = [| yield! creationDiags; yield! parseDiagnostics |]
@@ -876,7 +882,8 @@ type BackgroundCompiler
                         fileName,
                         tcDiagnostics,
                         suggestNamesForErrors,
-                        builder.TcConfig.flatErrors
+                        builder.TcConfig.flatErrors,
+                        symbolEnv
                     )
 
                 let tcDiagnostics = [| yield! creationDiags; yield! tcDiagnostics |]
@@ -1030,14 +1037,19 @@ type BackgroundCompiler
                 let tcDiagnostics = tcInfo.TcDiagnostics
                 let tcDependencyFiles = tcInfo.tcDependencyFiles
 
+                let symbolEnv =
+                    SymbolEnv(tcProj.TcGlobals, tcInfo.tcState.Ccu, Some tcInfo.tcState.CcuSig, tcProj.TcImports)
+                    |> Some
+
                 let tcDiagnostics =
                     DiagnosticHelpers.CreateDiagnostics(
                         diagnosticsOptions,
                         true,
                         fileName,
                         tcDiagnostics,
                         suggestNamesForErrors,
-                        builder.TcConfig.flatErrors
+                        builder.TcConfig.flatErrors,
+                        symbolEnv
                     )
 
                 let diagnostics = [| yield! creationDiags; yield! tcDiagnostics |]
@@ -1204,7 +1216,7 @@ type BackgroundCompiler
             let diags =
                 loadClosure.LoadClosureRootFileDiagnostics
                 |> List.map (fun (exn, isError) ->
-                    FSharpDiagnostic.CreateFromException(exn, isError, range.Zero, false, options.OtherOptions |> Array.contains "--flaterrors"))
+                    FSharpDiagnostic.CreateFromException(exn, isError, range.Zero, false, options.OtherOptions |> Array.contains "--flaterrors", None))
 
             return options, (diags @ diagnostics.Diagnostics)
         }