diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md index e4d5e280162..d3aba22abc7 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md @@ -9,6 +9,7 @@ * Type relations cache: handle potentially "infinite" types ([PR #19010](https://github.com/dotnet/fsharp/pull/19010)) * Disallow recursive structs with lifted type parameters ([Issue #18993](https://github.com/dotnet/fsharp/issues/18993), [PR #19031](https://github.com/dotnet/fsharp/pull/19031)) * Fix units-of-measure changes not invalidating incremental builds. ([Issue #19049](https://github.com/dotnet/fsharp/issues/19049)) +* Fix race in graph checking of type extensions. ([PR #19062](https://github.com/dotnet/fsharp/pull/19062)) * Type relations cache: handle unsolved type variables ([Issue #19037](https://github.com/dotnet/fsharp/issues/19037)) ([PR #19040](https://github.com/dotnet/fsharp/pull/19040)) ### Added diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 2a30e9def85..e230cd48280 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4217,18 +4217,7 @@ module TcDeclarations = let resInfo = TypeNameResolutionStaticArgsInfo.FromTyArgs synTypars.Length let tcref = match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurrence.Binding OpenQualified envForDecls.NameEnv ad longPath resInfo PermitDirectReferenceToGeneratedType.No with - | Result res -> - // Update resolved type parameters with the names from the source. - let _, tcref, _ = res - if tcref.TyparsNoRange.Length = synTypars.Length then - (tcref.TyparsNoRange, synTypars) - ||> List.zip - |> List.iter (fun (typar, SynTyparDecl.SynTyparDecl (typar = tp)) -> - let (SynTypar(ident = untypedIdent; staticReq = sr)) = tp - if typar.StaticReq = sr then - typar.SetIdent(untypedIdent) - ) - + | Result (_, tcref, _) -> tcref | Exception exn -> diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index ce880a4c608..12b7566db6e 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -724,7 +724,7 @@ module PrintTypes = (sprintf "%s%s%s" (if denv.showStaticallyResolvedTyparAnnotations then prefixOfStaticReq typar.StaticReq else "'") (if denv.showInferenceTyparAnnotations then prefixOfInferenceTypar typar else "") - typar.DisplayName) + (typar.DeclaredName |> Option.defaultValue typar.Name)) |> mkNav typar.Range |> wordL @@ -1199,12 +1199,12 @@ module PrintTypes = let prettyArgInfos denv allTyparInst = function | [] -> [(denv.g.unit_ty, ValReprInfo.unnamedTopArg1)] - | infos -> infos |> List.map (map1Of2 (instType allTyparInst)) + | infos -> infos |> List.map (map1Of2 (instType allTyparInst)) // Layout: type spec - class, datatype, record, abbrev let prettyLayoutOfMemberSigCore denv memberToParentInst (typarInst, methTypars: Typars, argInfos, retTy) = let niceMethodTypars, allTyparInst = - let methTyparNames = methTypars |> List.mapi (fun i tp -> if (PrettyTypes.NeedsPrettyTyparName tp) then sprintf "a%d" (List.length memberToParentInst + i) else tp.Name) + let methTyparNames = methTypars |> List.mapi (fun i tp -> if (PrettyTypes.NeedsPrettyTyparName tp) then sprintf "a%d" (List.length memberToParentInst + i) else tp.DeclaredName |> Option.defaultValue tp.Name ) PrettyTypes.NewPrettyTypars memberToParentInst methTypars methTyparNames let retTy = instType allTyparInst retTy @@ -1245,7 +1245,7 @@ module PrintTypes = let _niceMethodTypars, typarInst = let memberToParentInst = List.empty let typars = argInfos |> List.choose (function TType_var (typar, _),_ -> Some typar | _ -> None) - let methTyparNames = typars |> List.mapi (fun i tp -> if (PrettyTypes.NeedsPrettyTyparName tp) then sprintf "a%d" (List.length memberToParentInst + i) else tp.Name) + let methTyparNames = typars |> List.mapi (fun i tp -> if (PrettyTypes.NeedsPrettyTyparName tp) then sprintf "a%d" (List.length memberToParentInst + i) else tp.DeclaredName |> Option.defaultValue tp.Name) PrettyTypes.NewPrettyTypars memberToParentInst typars methTyparNames let retTy = instType typarInst retTy diff --git a/src/Compiler/Checking/SignatureConformance.fs b/src/Compiler/Checking/SignatureConformance.fs index 00df5d719b8..f6c575cbb4f 100644 --- a/src/Compiler/Checking/SignatureConformance.fs +++ b/src/Compiler/Checking/SignatureConformance.fs @@ -143,6 +143,9 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = if check then errorR (Error(FSComp.SR.typrelSigImplNotCompatibleCompileTimeRequirementsDiffer(), m)) + if not (PrettyTypes.NeedsPrettyTyparName implTypar) then + implTypar.PreserveDeclaredName() + // Adjust the actual type parameter name to look like the signature implTypar.SetIdent (mkSynId implTypar.Range sigTypar.Id.idText) diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index a8937babc93..e7be325ce33 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2260,6 +2260,9 @@ type TyparOptionalData = /// Set to true if the typar is contravariant, i.e. declared as in C# mutable typar_is_contravariant: bool + + /// The declared name of the type parameter. + mutable typar_declared_name: string option } [] @@ -2361,10 +2364,10 @@ type Typar = member x.SetAttribs attribs = match attribs, x.typar_opt_data with | [], None -> () - | [], Some { typar_il_name = None; typar_xmldoc = doc; typar_constraints = []; typar_is_contravariant = false } when doc.IsEmpty -> + | [], Some { typar_il_name = None; typar_xmldoc = doc; typar_constraints = []; typar_is_contravariant = false; typar_declared_name = None } when doc.IsEmpty -> x.typar_opt_data <- None | _, Some optData -> optData.typar_attribs <- attribs - | _ -> x.typar_opt_data <- Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = attribs; typar_is_contravariant = false } + | _ -> x.typar_opt_data <- Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = attribs; typar_is_contravariant = false; typar_declared_name = None } /// Get the XML documentation for the type parameter member x.XmlDoc = @@ -2382,7 +2385,20 @@ type Typar = member x.SetILName il_name = match x.typar_opt_data with | Some optData -> optData.typar_il_name <- il_name - | _ -> x.typar_opt_data <- Some { typar_il_name = il_name; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = []; typar_is_contravariant = false } + | _ -> x.typar_opt_data <- Some { typar_il_name = il_name; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = []; typar_is_contravariant = false; typar_declared_name = None} + + /// Get the declared name of the type parameter + member x.DeclaredName = + match x.typar_opt_data with + | Some optData -> optData.typar_declared_name + | _ -> None + + /// Save the name as the declared name of the type parameter if it is not already set + member x.PreserveDeclaredName() = + match x.typar_opt_data with + | Some optData when optData.typar_declared_name = None -> optData.typar_declared_name <- Some x.Name + | None -> x.typar_opt_data <- Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = []; typar_is_contravariant = false; typar_declared_name = Some x.Name } + | _ -> () /// Indicates the display name of a type variable member x.DisplayName = if x.Name = "?" then "?"+string x.Stamp else x.Name @@ -2391,17 +2407,17 @@ type Typar = member x.SetConstraints cs = match cs, x.typar_opt_data with | [], None -> () - | [], Some { typar_il_name = None; typar_xmldoc = doc; typar_attribs = [];typar_is_contravariant = false } when doc.IsEmpty -> + | [], Some { typar_il_name = None; typar_xmldoc = doc; typar_attribs = [];typar_is_contravariant = false; typar_declared_name = None } when doc.IsEmpty -> x.typar_opt_data <- None | _, Some optData -> optData.typar_constraints <- cs - | _ -> x.typar_opt_data <- Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = cs; typar_attribs = []; typar_is_contravariant = false } + | _ -> x.typar_opt_data <- Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = cs; typar_attribs = []; typar_is_contravariant = false; typar_declared_name = None } /// Marks the typar as being contravariant member x.MarkAsContravariant() = match x.typar_opt_data with | Some optData -> optData.typar_is_contravariant <- true | _ -> - x.typar_opt_data <- Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = []; typar_is_contravariant = true } + x.typar_opt_data <- Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = []; typar_is_contravariant = true; typar_declared_name = None } /// Creates a type variable that contains empty data, and is not yet linked. Only used during unpickling of F# metadata. static member NewUnlinked() : Typar = @@ -2423,7 +2439,7 @@ type Typar = x.typar_solution <- tg.typar_solution match tg.typar_opt_data with | Some tg -> - let optData = { typar_il_name = tg.typar_il_name; typar_xmldoc = tg.typar_xmldoc; typar_constraints = tg.typar_constraints; typar_attribs = tg.typar_attribs; typar_is_contravariant = tg.typar_is_contravariant } + let optData = { typar_il_name = tg.typar_il_name; typar_xmldoc = tg.typar_xmldoc; typar_constraints = tg.typar_constraints; typar_attribs = tg.typar_attribs; typar_is_contravariant = tg.typar_is_contravariant; typar_declared_name = tg.typar_declared_name } x.typar_opt_data <- Some optData | None -> () @@ -6183,7 +6199,7 @@ type Construct() = typar_opt_data = match attribs with | [] -> None - | _ -> Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = attribs; typar_is_contravariant = false } } + | _ -> Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = attribs; typar_is_contravariant = false; typar_declared_name = None } } /// Create a new type parameter node for a declared type parameter static member NewRigidTypar nm m = diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index b47b0ebcdd3..20014a13a64 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -1494,6 +1494,9 @@ type TyparOptionalData = /// Set to true if the typar is contravariant, i.e. declared as in C# mutable typar_is_contravariant: bool + + /// The declared name of the type parameter. + mutable typar_declared_name: string option } override ToString: unit -> string @@ -1562,6 +1565,9 @@ type Typar = /// Set the IL name of the type parameter member SetILName: il_name: string option -> unit + /// Saves the name as the declared name of the type parameter if it is not already set. + member PreserveDeclaredName: unit -> unit + /// Sets the identifier associated with a type variable member SetIdent: id: Ident -> unit @@ -1594,6 +1600,9 @@ type Typar = [] member DebugText: string + /// Gets the declared name of the type parameter. + member DeclaredName: string option + /// Indicates the display name of a type variable member DisplayName: string diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fs b/src/Compiler/TypedTree/TypedTreeBasics.fs index bf2e17c1c13..76f58275fb6 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fs +++ b/src/Compiler/TypedTree/TypedTreeBasics.fs @@ -197,7 +197,7 @@ let mkTyparTy (tp:Typar) = // For fresh type variables clear the StaticReq when copying because the requirement will be re-established through the // process of type inference. let copyTypar clearStaticReq (tp: Typar) = - let optData = tp.typar_opt_data |> Option.map (fun tg -> { typar_il_name = tg.typar_il_name; typar_xmldoc = tg.typar_xmldoc; typar_constraints = tg.typar_constraints; typar_attribs = tg.typar_attribs; typar_is_contravariant = tg.typar_is_contravariant }) + let optData = tp.typar_opt_data |> Option.map (fun tg -> { typar_il_name = tg.typar_il_name; typar_xmldoc = tg.typar_xmldoc; typar_constraints = tg.typar_constraints; typar_attribs = tg.typar_attribs; typar_is_contravariant = tg.typar_is_contravariant; typar_declared_name = tg.typar_declared_name }) let flags = if clearStaticReq then tp.typar_flags.WithStaticReq(TyparStaticReq.None) else tp.typar_flags Typar.New { typar_id = tp.typar_id typar_flags = flags diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index 72200e32fd8..8a61809ab06 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -2406,6 +2406,7 @@ let u_tyar_spec_data st = typar_constraints = e typar_attribs = c typar_is_contravariant = false + typar_declared_name = None } } diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/TypeTests.fs b/tests/FSharp.Compiler.ComponentTests/Signatures/TypeTests.fs index d025052b6fb..e534b5d325b 100644 --- a/tests/FSharp.Compiler.ComponentTests/Signatures/TypeTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/TypeTests.fs @@ -308,4 +308,38 @@ let foo = Foo() | :? FSharpMemberOrFunctionOrValue as mfv -> Assert.False(mfv.IsUnionCaseTester, "IsUnionCaseTester returned true") Assert.True(mfv.IsConstructor) - | _ -> failwith "Expected FSharpMemberOrFunctionOrValue" \ No newline at end of file + | _ -> failwith "Expected FSharpMemberOrFunctionOrValue" + + + +[] +let ``Type extension type parameters do not overwrite the type being extended`` () = + let one = + FSharpWithFileName "One.fs" """ +module One + +type GenericType<'ActualType> = { + Value: 'ActualType +} +""" + + let two = + FsSourceWithFileName "Two.fs" """ +module Two +type One.GenericType<'U> with + member x.Print () = printfn "%A" x.Value +""" + + let three = + FsSourceWithFileName "Three.fs" """ +module Three + +open One + +type GenericType<'X> with + member _.Nothing() = ignore () +""" + + one |> withAdditionalSourceFiles [ two; three ] + |> compile + |> verifyILContains [ ".Print" ] \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/TyparNameTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/TyparNameTests.fs index d8316d365e7..174a5fa15cb 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/TyparNameTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/TyparNameTests.fs @@ -141,3 +141,32 @@ let array2D (rows: seq<#seq<'T>>) : 'T[,] = failwith "todo" getGenericParametersNamesFor signatureFile "A" "array2D" implementationFile Assert.Equal([| "a"; "T" |], names) + + [] + let ``Type extension type parameters are preserved as declared name`` () = + let one = + FSharpWithFileName "One.fs" """ +module One + +type GenericType<'ActualType> = { + Value: 'ActualType +} + """ + |> withFileName "One.fs" + + let two = + FsSourceWithFileName "Two.fs" """ +module Two +type One.GenericType<'DeclaredType> with + member x.Print () = printfn "%A" x.Value + """ + + let result = + one |> withAdditionalSourceFile two + |> typecheckProject false CompilerAssertHelpers.UseTransparentCompiler + + let typar = + result.AssemblySignature.Entities[0].MembersFunctionsAndValues[0].GenericParameters[0].TypeParameter + + Assert.Equal(Some "DeclaredType", typar.DeclaredName) + Assert.Equal("ActualType", typar.Name) diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index ba954b0ce53..5df00581c7f 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -455,6 +455,9 @@ module rec Compiler = let FsSource source = SourceCodeFileKind.Fs({FileName="test.fs"; SourceText=Some source }) + let FsSourceWithFileName name source = + SourceCodeFileKind.Fs({FileName=name; SourceText=Some source }) + let CsSource source = SourceCodeFileKind.Cs({FileName="test.cs"; SourceText=Some source })