Fix #16432: Report FS0039 only once for undefined type in inherit clause

docs/release-notes/.FSharp.Compiler.Service/11.0.100.md

@@ -1,5 +1,6 @@
 ### Fixed
 
+* Report `FS0039` only once when a class `inherit` clause references an undefined base type. ([Issue #16432](https://github.com/dotnet/fsharp/issues/16432), [PR #19862](https://github.com/dotnet/fsharp/pull/19862))
 * Fix FS0421 "The address of the variable cannot be used at this point" incorrectly raised for the discard pattern `let _ = &expr` when `let x = &expr` compiles. ([Issue #18841](https://github.com/dotnet/fsharp/issues/18841), [PR #19811](https://github.com/dotnet/fsharp/pull/19811))
 * Honor `--nowarn` and `--warnaserror` for warnings emitted during command-line option parsing ([Issue #19576](https://github.com/dotnet/fsharp/issues/19576), [PR #19776](https://github.com/dotnet/fsharp/pull/19776))
 * Fix `[<return: X>]` prefix attributes being silently dropped on class members, and fix false-positive `AllowMultiple=false` errors when `[<X>]` and `[<return: X>]` are applied to the same binding. ([Issue #17904](https://github.com/dotnet/fsharp/issues/17904), [Issue #19020](https://github.com/dotnet/fsharp/issues/19020), [PR #19738](https://github.com/dotnet/fsharp/pull/19738))

src/Compiler/Checking/CheckBasics.fs

@@ -313,6 +313,12 @@ type TcFileState =
 
       argInfoCache: ConcurrentDictionary<string * range, ArgReprInfo>
 
+      /// Tracks (range, identifier-text) keys of `UndefinedName` diagnostics that have already
+      /// been reported during this cenv's lifetime so they can be deduplicated when the same
+      /// identifier is re-resolved by multiple passes (e.g. Phase 1F vs. Phase 2A of an
+      /// `inherit` clause). See issue dotnet/fsharp#16432.
+      reportedUndefinedNames: ConcurrentDictionary<struct (range * string), unit>
+
       // forward call
       TcPat: WarnOnUpperFlag -> TcFileState -> TcEnv -> PrelimValReprInfo option -> TcPatValFlags -> TcPatLinearEnv -> TType -> SynPat -> (TcPatPhase2Input -> Pattern) * TcPatLinearEnv
 
@@ -363,6 +369,7 @@ type TcFileState =
           isInternalTestSpanStackReferring = isInternalTestSpanStackReferring
           diagnosticOptions = diagnosticOptions
           argInfoCache = ConcurrentDictionary()
+          reportedUndefinedNames = ConcurrentDictionary()
           TcPat = tcPat
           TcSimplePats = tcSimplePats
           TcSequenceExpressionEntry = tcSequenceExpressionEntry

src/Compiler/Checking/CheckBasics.fsi

@@ -274,6 +274,12 @@ type TcFileState =
         /// we're always dealing with the same instance and the updates don't get lost
         argInfoCache: ConcurrentDictionary<string * range, ArgReprInfo>
 
+        /// Tracks (range, identifier-text) keys of `UndefinedName` diagnostics that have already
+        /// been reported during this cenv's lifetime so they can be deduplicated when the same
+        /// identifier is re-resolved by multiple passes (e.g. Phase 1F vs. Phase 2A of an
+        /// `inherit` clause). See issue dotnet/fsharp#16432.
+        reportedUndefinedNames: ConcurrentDictionary<struct (range * string), unit>
+
         // forward call
         TcPat:
             WarnOnUpperFlag

src/Compiler/Checking/CheckDeclarations.fs

@@ -3,6 +3,7 @@
 module internal FSharp.Compiler.CheckDeclarations
 
 open System
+open System.Collections.Concurrent
 open System.Collections.Generic
 open System.Threading
 
@@ -48,8 +49,38 @@ open FSharp.Compiler.TypeRelations
 open FSharp.Compiler.TypeProviders
 #endif
 
+/// A diagnostics-logger wrapper used while type-checking an `inherit` clause. It drops any
+/// `UndefinedName` diagnostic whose `(id.idRange, id.idText)` key has already been seen in
+/// the same `cenv`, so duplicate FS0039s caused by re-resolution across Phase 1F / Phase 2A
+/// are suppressed. All other diagnostics are forwarded unchanged. See issue #16432.
+type private InheritDedupDiagnosticsLogger
+    (seen: ConcurrentDictionary<struct (range * string), unit>, inner: DiagnosticsLogger) =
+    inherit DiagnosticsLogger("InheritDedupDiagnosticsLogger")
+
+    // Only `WrappedError` is unwrapped here: it is the single wrapper that the
+    // `inherit` type-checking path can place around an `UndefinedName`. Other diagnostic
+    // exception families (`StopProcessingExn`/`ReportedError` short-circuit before reaching
+    // the sink, and `DiagnosticWithSuggestions` etc. are peer errors, not wrappers).
+    let rec isDuplicateUndefinedName (e: exn) =
+        match e with
+        | UndefinedName(_, _, id, _) -> not (seen.TryAdd(struct (id.idRange, id.idText), ()))
+        | WrappedError(inner, _) -> isDuplicateUndefinedName inner
+        | _ -> false
+
+    override _.DiagnosticSink(diagnostic: PhasedDiagnostic) =
+        if not (isDuplicateUndefinedName diagnostic.Exception) then
+            inner.DiagnosticSink diagnostic
+
+    override _.ErrorCount = inner.ErrorCount
+
+    override _.CheckForRealErrorsIgnoringWarnings = inner.CheckForRealErrorsIgnoringWarnings
+
 type cenv = TcFileState
 
+let private useInheritDedupLogger (cenv: cenv) =
+    UseTransformedDiagnosticsLogger(fun inner ->
+        InheritDedupDiagnosticsLogger(cenv.reportedUndefinedNames, inner) :> DiagnosticsLogger)
+
 //-------------------------------------------------------------------------
 // Mutually recursive shapes
 //------------------------------------------------------------------------- 
@@ -1366,6 +1397,7 @@ module MutRecBindingChecking =
 
                         // Phase2B: typecheck the argument to an 'inherits' call and build the new object expr for the inherit-call 
                         | Phase2AInherit (synBaseTy, arg, baseValOpt, m) ->
+                            use _ = useInheritDedupLogger cenv
                             let inheritsExpr, tpenv =
                                 try
                                    let baseTy, tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurrence.Use WarnOnIWSAM.Yes envInstance tpenv synBaseTy
@@ -3317,7 +3349,9 @@ module EstablishTypeDefinitionCores =
                         let kind = InferTyconKind g (kind, attrs, slotsigs, fields, inSig, isConcrete, m)
 
                         let inherits = inherits |> List.map (fun (ty, m, _) -> (ty, m)) 
-                        let inheritedTys = fst (List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkConstraints ItemOccurrence.UseInType WarnOnIWSAM.No envinner)) tpenv inherits)
+                        let inheritedTys =
+                            use _ = useInheritDedupLogger cenv
+                            fst (List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkConstraints ItemOccurrence.UseInType WarnOnIWSAM.No envinner)) tpenv inherits)
                         let implementedTys, inheritedTys =   
                             match kind with 
                             | SynTypeDefnKind.Interface -> 

tests/FSharp.Compiler.ComponentTests/Conformance/ObjectOrientedTypeDefinitions/ClassTypes/InheritsDeclarations/InheritsDeclarations.fs

@@ -56,3 +56,90 @@ module InheritsDeclarations =
         |> ignoreWarnings
         |> compile
         |> shouldSucceed
+
+    // Regression tests for https://github.com/dotnet/fsharp/issues/16432:
+    // inheriting from an unknown type should emit FS0039 only once,
+    // not three times (once per name-resolution site in CheckDeclarations).
+
+    [<Fact>]
+    let ``Inherit nonexistent type reports single FS0039`` () =
+        let result =
+            FSharp """
+type MyClass() =
+    inherit NonExistentBase()
+"""
+            |> typecheck
+
+        let fs39 =
+            result.Output.Diagnostics
+            |> List.filter (fun d -> d.Error = (Error 39))
+
+        Assert.True(
+            fs39.Length = 1,
+            sprintf "Expected exactly 1 FS0039 but got %d. Diagnostics:\n%A" fs39.Length result.Output.Diagnostics
+        )
+
+    [<Fact>]
+    let ``Two different undefined names still report separately`` () =
+        let result =
+            FSharp """
+type MyClass() =
+    inherit NonExistentBase()
+    member _.X = undefinedValue
+"""
+            |> typecheck
+
+        let fs39 =
+            result.Output.Diagnostics
+            |> List.filter (fun d -> d.Error = (Error 39))
+
+        Assert.True(
+            fs39.Length >= 2,
+            sprintf "Expected >= 2 FS0039, got %d. Diagnostics:\n%A" fs39.Length result.Output.Diagnostics
+        )
+
+    [<Fact>]
+    let ``Inherit with generic nonexistent type single error`` () =
+        let result =
+            FSharp """
+type MyClass() =
+    inherit MissingGeneric<int>()
+"""
+            |> typecheck
+
+        let fs39 =
+            result.Output.Diagnostics
+            |> List.filter (fun d -> d.Error = (Error 39))
+
+        Assert.True(
+            fs39.Length = 1,
+            sprintf "Expected exactly 1 FS0039 but got %d. Diagnostics:\n%A" fs39.Length result.Output.Diagnostics
+        )
+
+    [<Fact>]
+    let ``Valid inherit produces no FS0039`` () =
+        FSharp """
+open System
+type MyClass() =
+    inherit Exception("test")
+"""
+        |> typecheck
+        |> shouldSucceed
+
+    [<Fact>]
+    let ``Interface inherit nonexistent single error`` () =
+        let result =
+            FSharp """
+type IMyInterface =
+    inherit INonExistent
+"""
+            |> typecheck
+
+        let fs39 =
+            result.Output.Diagnostics
+            |> List.filter (fun d -> d.Error = (Error 39))
+
+        Assert.True(
+            fs39.Length = 1,
+            sprintf "Expected exactly 1 FS0039 but got %d. Diagnostics:\n%A" fs39.Length result.Output.Diagnostics
+        )