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
 
+* Fixed: Inheriting from an undefined type now reports `FS0039` exactly once instead of three times. Phase 1F and Phase 2A of inherit-clause type-checking now skip re-resolving a syntactic clause whose Phase 1D resolution already failed with `UndefinedName`, eliminating both the duplicate diagnostic and the redundant work. ([Issue #16432](https://github.com/dotnet/fsharp/issues/16432), [PR #19862](https://github.com/dotnet/fsharp/pull/19862))
 * Suppress hover/symbol resolution for wildcard `_` patterns inside `member _.…` bodies that incorrectly showed `val _: T` tooltip. ([PR #19760](https://github.com/dotnet/fsharp/pull/19760))
 * Deduplicate format specifier locations in computation expressions so editor tooling no longer reports duplicate entries for the same `%` specifier. ([Issue #16419](https://github.com/dotnet/fsharp/issues/16419), [PR #19791](https://github.com/dotnet/fsharp/pull/19791))
 * Reject non-function bindings for single-case and partial active pattern names with FS1209, matching the existing multi-case behavior. ([PR #19763](https://github.com/dotnet/fsharp/pull/19763))

src/Compiler/Checking/CheckBasics.fs

@@ -313,6 +313,9 @@ type TcFileState =
 
       argInfoCache: ConcurrentDictionary<string * range, ArgReprInfo>
 
+      /// Inherit clauses whose type already failed UndefinedName; skip re-resolution to avoid duplicate FS0039.
+      inheritResolutionFailed: ConcurrentDictionary<struct (Stamp * range), unit>
+
       // forward call
       TcPat: WarnOnUpperFlag -> TcFileState -> TcEnv -> PrelimValReprInfo option -> TcPatValFlags -> TcPatLinearEnv -> TType -> SynPat -> (TcPatPhase2Input -> Pattern) * TcPatLinearEnv
 
@@ -363,6 +366,7 @@ type TcFileState =
           isInternalTestSpanStackReferring = isInternalTestSpanStackReferring
           diagnosticOptions = diagnosticOptions
           argInfoCache = ConcurrentDictionary()
+          inheritResolutionFailed = ConcurrentDictionary()
           TcPat = tcPat
           TcSimplePats = tcSimplePats
           TcSequenceExpressionEntry = tcSequenceExpressionEntry

src/Compiler/Checking/CheckBasics.fsi

@@ -274,6 +274,9 @@ type TcFileState =
         /// we're always dealing with the same instance and the updates don't get lost
         argInfoCache: ConcurrentDictionary<string * range, ArgReprInfo>
 
+        /// Inherit clauses whose type already failed UndefinedName; skip re-resolution to avoid duplicate FS0039.
+        inheritResolutionFailed: ConcurrentDictionary<struct (Stamp * range), unit>
+
         // forward call
         TcPat:
             WarnOnUpperFlag

src/Compiler/Checking/CheckDeclarations.fs

@@ -50,6 +50,15 @@ open FSharp.Compiler.TypeProviders
 
 type cenv = TcFileState
 
+let rec (|UndefinedNameError|_|) (e: exn) =
+    match e with
+    | UndefinedName _ -> Some ()
+    | WrappedError(inner, _)
+    | ErrorFromAddingTypeEquation(error = inner)
+    | ErrorFromAddingConstraint(error = inner)
+    | ErrorFromApplyingDefault(error = inner) -> (|UndefinedNameError|_|) inner
+    | _ -> None
+
 //-------------------------------------------------------------------------
 // Mutually recursive shapes
 //------------------------------------------------------------------------- 
@@ -1367,14 +1376,17 @@ 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) ->
                             let inheritsExpr, tpenv =
-                                try
-                                   let baseTy, tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurrence.Use WarnOnIWSAM.Yes envInstance tpenv synBaseTy
-                                   let baseTy = baseTy |> convertToTypeWithMetadataIfPossible g
-                                   let mTcNew = unionRanges synBaseTy.Range arg.Range
-                                   TcNewExpr cenv envInstance tpenv baseTy (Some synBaseTy.Range) true arg mTcNew
-                                with RecoverableException e ->
-                                    errorRecovery e m
+                                if cenv.inheritResolutionFailed.ContainsKey(struct (tcref.Stamp, synBaseTy.Range)) then
                                     mkUnit g m, tpenv
+                                else
+                                    try
+                                       let baseTy, tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurrence.Use WarnOnIWSAM.Yes envInstance tpenv synBaseTy
+                                       let baseTy = baseTy |> convertToTypeWithMetadataIfPossible g
+                                       let mTcNew = unionRanges synBaseTy.Range arg.Range
+                                       TcNewExpr cenv envInstance tpenv baseTy (Some synBaseTy.Range) true arg mTcNew
+                                    with RecoverableException e ->
+                                        errorRecovery e m
+                                        mkUnit g m, tpenv
                             let envInstance = match baseValOpt with Some baseVal -> AddLocalVal g cenv.tcSink scopem baseVal envInstance | None -> envInstance
                             let envNonRec = match baseValOpt with Some baseVal -> AddLocalVal g cenv.tcSink scopem baseVal envNonRec | None -> envNonRec
                             let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable)
@@ -3317,7 +3329,23 @@ 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 tryResolveInheritType tpenv (ty: SynType, m) =
+                            let key = struct (tcref.Stamp, ty.Range)
+                            if cenv.inheritResolutionFailed.ContainsKey key then
+                                (g.obj_ty_ambivalent, m), tpenv
+                            else
+                                try
+                                    let resolved, tpenv = TcType cenv NoNewTypars checkConstraints ItemOccurrence.UseInType WarnOnIWSAM.No envinner tpenv ty
+                                    (resolved, m), tpenv
+                                with
+                                | RecoverableException (UndefinedNameError as e) ->
+                                    errorRecovery e ty.Range
+                                    cenv.inheritResolutionFailed.TryAdd(key, ()) |> ignore
+                                    (g.obj_ty_ambivalent, m), tpenv
+                                | RecoverableException e ->
+                                    errorRecovery e ty.Range
+                                    (g.obj_ty_ambivalent, m), tpenv
+                        let inheritedTys = inherits |> List.mapFold tryResolveInheritType tpenv |> fst
                         let implementedTys, inheritedTys =   
                             match kind with 
                             | SynTypeDefnKind.Interface -> 

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

@@ -56,3 +56,55 @@ module InheritsDeclarations =
         |> ignoreWarnings
         |> compile
         |> shouldSucceed
+
+    [<Fact>]
+    let ``Inherit from undefined non-generic type reports single FS0039`` () =
+        FSharp "type MyClass() =\n    inherit NonExistentBase()\n"
+        |> typecheck
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 39, Line 2, Col 13, Line 2, Col 28, "The type 'NonExistentBase' is not defined.")
+        ]
+
+    [<Fact>]
+    let ``Inherit from undefined generic type reports single FS0039`` () =
+        FSharp "type MyClass() =\n    inherit MissingGeneric<int>()\n"
+        |> typecheck
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 39, Line 2, Col 13, Line 2, Col 27, "The type 'MissingGeneric' is not defined.")
+        ]
+
+    [<Fact>]
+    let ``Interface inheriting undefined interface reports single FS0039`` () =
+        FSharp "type IMyInterface =\n    inherit INonExistent\n"
+        |> typecheck
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 39, Line 2, Col 13, Line 2, Col 25, "The type 'INonExistent' is not defined.")
+            (Error 887, Line 2, Col 5, Line 2, Col 25, "The type 'obj' is not an interface type")
+        ]
+
+    [<Fact>]
+    let ``Undefined inherit and undefined value report independently`` () =
+        FSharp """
+type MyClass() =
+    inherit NonExistentBase()
+    member _.X = undefinedValue
+"""
+        |> typecheck
+        |> shouldFail
+        |> withDiagnostics [
+            (Error 39, Line 3, Col 13, Line 3, Col 28, "The type 'NonExistentBase' is not defined.")
+            (Error 39, Line 4, Col 18, Line 4, Col 32, "The value or constructor 'undefinedValue' is not defined.")
+        ]
+
+    [<Fact>]
+    let ``Valid inherit produces no diagnostics`` () =
+        FSharp """
+open System
+type MyClass() =
+    inherit Exception("test")
+"""
+        |> typecheck
+        |> shouldSucceed