Don't find witnesses for typars with conditional constraints

src/Compiler/Symbols/Exprs.fs

@@ -508,14 +508,47 @@ module FSharpExprConvert =
 
     and GetWitnessArgs cenv (env: ExprTranslationEnv) (vref: ValRef) m tps tyargs : FSharpExpr list =
         let g = cenv.g
-        if g.langVersion.SupportsFeature(Features.LanguageFeature.WitnessPassing) && not env.suppressWitnesses then 
-            let witnessExprs = 
+        if g.langVersion.SupportsFeature(Features.LanguageFeature.WitnessPassing) && not env.suppressWitnesses then
+            /// There are two *conditional* properties a typar can have: equality and comparison.
+            /// A generic type having that constraint may be conditional on whether a specific type parameter to that generic has that
+            /// constraint.
+            /// This function returns `true` iff after unification, the type definition contains any conditional typars.
+            ///
+            /// Note that these conditions are only marked on typars that actually appear in the code, *not* on phantom types.
+            /// So `hasConditionalTypar` should tell us exactly when the type parameter is actually being used in the type's equality or
+            /// comparison.
+            let rec hasConditionalTypar ty =
+                match stripTyEqns g ty with
+                | TType_var (tp, _) -> tp.ComparisonConditionalOn || tp.EqualityConditionalOn
+                | TType_app (_, tinst, _) -> tinst |> List.exists hasConditionalTypar
+                | _ -> false
+
+            let witnessExprs =
                 match ConstraintSolver.CodegenWitnessesForTyparInst cenv.tcValF g cenv.amap m tps tyargs with
                 // There is a case where optimized code makes expressions that do a shift-left on the 'char'
                 // type.  There is no witness for this case.  This is due to the code
                 //    let inline HashChar (x:char) = (# "or" (# "shl" x 16 : int #) x : int #)
-                // in FSharp.Core. 
+                // in FSharp.Core.
                 | ErrorResult _  when vref.LogicalName = "op_LeftShift" && List.isSingleton tyargs -> []
+                // We don't need a witness either at compile time or runtime when there are conditional typars.
+                // Attempting to call a comparison operation with the type causes a compile-time check that all the generic type args
+                // support comparison (thanks to the ComparisonConditionalOn mechanism); the compile-time check doesn't need witnesses,
+                // it's just pure constraint solving.
+                // Nor do we need a witness for runtime logic: the compiler generates a `CompareTo` method (see
+                // `MakeValsForCompareAugmentation`) which handles the comparison by dynamically type-testing, not going through a witness.
+                //
+                // So we don't need to generate a witness.
+                //
+                // In fact, we *can't* generate a witness, because the constraint on the type parameter is only conditional: a rigid type
+                // parameter, defined without the `comparison` constraint, cannot have the constraint added to it later (that's what "rigid"
+                // means). It would change the type signature of the type to add this constraint to the type parameter!
+                //
+                // This code path is only reached through the auto-generated comparison/equality code, which only calls single-constraint
+                // intrinsics: there's exactly one constraint per type parameter in each of those two cases.
+                // In theory, if a function had an autogenerated `'a : comparison and 'b : SomethingElse`, where the `SomethingElse` was
+                // not comparison and failed for a different reason, we'd spuriously hide that failure here; but in fact the only code
+                // paths which get here have no other constraints.
+                | ErrorResult _ when List.exists hasConditionalTypar tyargs -> []
                 | res -> CommitOperationResult res
             let env = { env with suppressWitnesses = true }
             witnessExprs |> List.map (fun arg -> 

src/Compiler/TypedTree/TypedTreeBasics.fsi

@@ -141,6 +141,8 @@ val tryShortcutSolvedUnitPar: canShortcut: bool -> r: Typar -> Measure
 
 val stripUnitEqnsAux: canShortcut: bool -> unt: Measure -> Measure
 
+/// Follows type variable solutions: when a type variable has been solved by unifying it with another type,
+/// replaces that type variable with its solution.
 val stripTyparEqnsAux: nullness0: Nullness -> canShortcut: bool -> ty: TType -> TType
 
 val replaceNullnessOfTy: nullness: Nullness -> ty: TType -> TType

src/Compiler/TypedTree/TypedTreeOps.fsi

@@ -604,9 +604,41 @@ val reduceTyconRefMeasureableOrProvided: TcGlobals -> TyconRef -> TypeInst -> TT
 
 val reduceTyconRefAbbrevMeasureable: TyconRef -> Measure
 
-/// set bool to 'true' to allow shortcutting of type parameter equation chains during stripping
-val stripTyEqnsA: TcGlobals -> bool -> TType -> TType
-
+/// <summary>
+/// Normalizes types.
+/// </summary>
+/// <remarks>
+/// Normalizes a type by:
+/// <list>
+///   <item>replacing type variables with their solutions found by unification</item>
+///   <item>expanding type abbreviations</item>
+/// </list>
+/// as well as a couple of special-case normalizations:
+/// <list>
+///   <item>identifying <c>int&lt;1&gt;</c> with <c>int</c> (for any measurable type)</item>
+///   <item>identifying <c>byref&lt;'T&gt;</c> with <c>byref&lt;'T, ByRefKinds.InOut&gt;</c></item>
+/// </list>
+/// </remarks>
+/// <param name="canShortcut">
+/// <c>true</c> to allow shortcutting of type parameter equation chains during stripping
+/// </param>
+val stripTyEqnsA: TcGlobals -> canShortcut: bool -> TType -> TType
+
+/// <summary>
+/// Normalizes types.
+/// </summary>
+/// <remarks>
+/// Normalizes a type by:
+/// <list>
+///   <item>replacing type variables with their solutions found by unification</item>
+///   <item>expanding type abbreviations</item>
+/// </list>
+/// as well as a couple of special-case normalizations:
+/// <list>
+///   <item>identifying <c>int&lt;1&gt;</c> with <c>int</c> (for any measurable type)</item>
+///   <item>identifying <c>byref&lt;'T&gt;</c> with <c>byref&lt;'T, ByRefKinds.InOut&gt;</c></item>
+/// </list>
+/// </remarks>
 val stripTyEqns: TcGlobals -> TType -> TType
 
 val stripTyEqnsAndMeasureEqns: TcGlobals -> TType -> TType
@@ -707,6 +739,8 @@ val tcrefOfAppTy: TcGlobals -> TType -> TyconRef
 
 val tryTcrefOfAppTy: TcGlobals -> TType -> TyconRef voption
 
+/// Returns ValueSome if this type is a type variable, even after abbreviations are expanded and
+/// variables have been solved through unification.
 val tryDestTyparTy: TcGlobals -> TType -> Typar voption
 
 val tryDestFunTy: TcGlobals -> TType -> (TType * TType) voption

tests/FSharp.Compiler.Service.Tests/ExprTests.fs

@@ -3504,3 +3504,193 @@ let ``Test ProjectForWitnesses4 GetWitnessPassingInfo`` () =
     printfn "actual:\n\n%A" actual
     actual
       |> shouldEqual expected
+
+//---------------------------------------------------------------------------------------------------------
+// Regression tests for ImmediateSubExpressions on generic types with conditional comparison/equality
+// https://github.com/dotnet/fsharp/issues/19118
+//
+// The bug: FCS crashes when accessing ImmediateSubExpressions on auto-generated comparison code
+// for generic DUs/records whose type parameters have ComparisonConditionalOn but not actual
+// comparison constraints. This is because GetWitnessArgs tries to generate witnesses for the
+// comparison constraint, but fails because the type parameter is rigid and can't have constraints added.
+
+module internal ProjectForWitnessConditionalComparison =
+
+    /// Helper to walk ALL expressions in a file, including ImmediateSubExpressions
+    /// This triggers the bug because it forces conversion of auto-generated comparison code
+    let walkAllExpressions (source : string) =
+        let fileName1 = System.IO.Path.ChangeExtension(getTemporaryFileName (), ".fs")
+        try
+            FileSystem.OpenFileForWriteShim(fileName1).Write(source)
+            let options = createProjectOptions [source] []
+            let exprChecker = FSharpChecker.Create(keepAssemblyContents=true, useTransparentCompiler=CompilerAssertHelpers.UseTransparentCompiler)
+            let wholeProjectResults = exprChecker.ParseAndCheckProject(options) |> Async.RunImmediate
+
+            if wholeProjectResults.Diagnostics.Length > 0 then
+                for diag in wholeProjectResults.Diagnostics do
+                    printfn "Diagnostic: %s" diag.Message
+
+            for implFile in wholeProjectResults.AssemblyContents.ImplementationFiles do
+                // Walk all declarations and their expressions, including ImmediateSubExpressions
+                let rec walkExpr (e: FSharpExpr) =
+                    // Access ImmediateSubExpressions - this is what triggered #19118
+                    for subExpr in e.ImmediateSubExpressions do
+                        walkExpr subExpr
+
+                let rec walkDecl d =
+                    match d with
+                    | FSharpImplementationFileDeclaration.Entity (_, subDecls) ->
+                        for subDecl in subDecls do
+                            walkDecl subDecl
+                    | FSharpImplementationFileDeclaration.MemberOrFunctionOrValue (_, _, e) ->
+                        walkExpr e
+                    | FSharpImplementationFileDeclaration.InitAction e ->
+                        walkExpr e
+
+                for decl in implFile.Declarations do
+                    walkDecl decl
+        finally
+            try
+                FileSystem.FileDeleteShim fileName1
+            with
+            | _ -> ()
+
+[<Fact>]
+let ``ImmediateSubExpressions - generic DU with no constraints should not crash`` () =
+    // This is the core bug repro - a generic DU where the type parameter has
+    // ComparisonConditionalOn but no actual comparison constraint
+    let source = """
+module M
+
+type Bar<'appEvent> =
+    | Wibble of 'appEvent
+"""
+    // This should not throw. Before the fix, it crashed with ConstraintSolverMissingConstraint.
+    ProjectForWitnessConditionalComparison.walkAllExpressions source
+
+[<Fact>]
+let ``ImmediateSubExpressions - generic DU with multiple type parameters should not crash`` () =
+    let source = """
+module M
+
+type MultiParam<'a, 'b, 'c> =
+    | Case1 of 'a
+    | Case2 of 'b * 'c
+    | Case3 of 'a * 'b * 'c
+"""
+    ProjectForWitnessConditionalComparison.walkAllExpressions source
+
+[<Fact>]
+let ``ImmediateSubExpressions - generic record with no constraints should not crash`` () =
+    let source = """
+module M
+
+type MyRecord<'t> = { Value: 't; Name: string }
+"""
+    ProjectForWitnessConditionalComparison.walkAllExpressions source
+
+[<Fact>]
+let ``ImmediateSubExpressions - generic struct DU should not crash`` () =
+    let source = """
+module M
+
+[<Struct>]
+type StructDU<'a> =
+    | StructCase of value: 'a
+"""
+    ProjectForWitnessConditionalComparison.walkAllExpressions source
+
+[<Fact>]
+let ``ImmediateSubExpressions - nested generic types should not crash`` () =
+    let source = """
+module M
+
+type Outer<'a> =
+    | OuterCase of Inner<'a>
+
+and Inner<'b> =
+    | InnerCase of 'b
+"""
+    ProjectForWitnessConditionalComparison.walkAllExpressions source
+
+[<Fact>]
+let ``ImmediateSubExpressions - generic DU with explicit comparison constraint works`` () =
+    // When the type parameter has the comparison constraint, witness generation should work;
+    // no crash occurred even before the bug was fixed. This test is here for completeness.
+    let source = """
+module M
+
+type WithConstraint<'a when 'a : comparison> =
+    | Constrained of 'a
+"""
+    ProjectForWitnessConditionalComparison.walkAllExpressions source
+
+[<Fact>]
+let ``ImmediateSubExpressions - non-generic DU works`` () =
+    // Non-generic types always worked fine (no generics = no witness issues). This test is here for completeness.
+    let source = """
+module M
+
+type SimpleUnion =
+    | Case1 of int
+    | Case2 of string
+"""
+    ProjectForWitnessConditionalComparison.walkAllExpressions source
+
+[<Fact>]
+let ``ImmediateSubExpressions - generic DU with NoComparison attribute should not crash`` () =
+    // With NoComparison, no comparison code is generated, so no crash ever occurred even before the bug was fixed.
+    // This test is here for completeness.
+    let source = """
+module M
+
+[<NoComparison>]
+type NoCompare<'a> =
+    | NoCompareCase of 'a
+"""
+    ProjectForWitnessConditionalComparison.walkAllExpressions source
+
+[<Fact>]
+let ``ImmediateSubExpressions - generic DU with NoEquality attribute should not crash`` () =
+    let source = """
+module M
+
+[<NoEquality; NoComparison>]
+type NoEq<'a> =
+    | NoEqCase of 'a
+"""
+    ProjectForWitnessConditionalComparison.walkAllExpressions source
+
+[<Fact>]
+let ``ImmediateSubExpressions - generic DU used in function should not crash`` () =
+    // Test that using the generic DU in actual code still works
+    let source = """
+module M
+
+type Option2<'t> =
+    | Some2 of 't
+    | None2
+
+let mapOption2 f opt =
+    match opt with
+    | Some2 x -> Some2 (f x)
+    | None2 -> None2
+"""
+    ProjectForWitnessConditionalComparison.walkAllExpressions source
+
+[<Fact>]
+let ``ImmediateSubExpressions - complex generic type hierarchy should not crash`` () =
+    let source = """
+module M
+
+type Result<'ok, 'err> =
+    | Ok of 'ok
+    | Error of 'err
+
+type Validated<'a> = Result<'a, string list>
+
+let validate pred msg value : Validated<'a> =
+    if pred value then Ok value
+    else Error [msg]
+"""
+    ProjectForWitnessConditionalComparison.walkAllExpressions source