Skip to content

Commit 03085c3

Browse files
nojafnojaf
committed
Ensure that the signature file typar name is preserved.
1 parent 97f3d0a commit 03085c3

2 files changed

Lines changed: 69 additions & 21 deletions

File tree

‎src/Compiler/Checking/PostInferenceChecks.fs‎

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -106,6 +106,26 @@ type env =
106106

107107
override _.ToString() = "<env>"
108108

109+
/// The Typars of a Val in the signature data should also be pretty named.
110+
/// This will happen for the implementation file contents, but not for the signature data.
111+
/// In this module some helpers will traverse the ModuleOrNamespaceType and update all the typars of each found Val.
112+
module UpdatePrettyTyparNames =
113+
let rec private updateEntity (entity: Entity) =
114+
for e in entity.ModuleOrNamespaceType.AllEntities do
115+
updateEntity e
116+
for v in entity.ModuleOrNamespaceType.AllValsAndMembers do
117+
updateVal v
118+
119+
and private updateVal (v: Val) =
120+
if not (List.isEmpty v.Typars) then
121+
let nms = PrettyTypes.PrettyTyparNames (fun _ -> true) List.empty v.Typars
122+
(v.Typars, nms)
123+
||> List.iter2 (fun tp nm -> tp.typar_id <- ident (nm, tp.Range))
124+
125+
and updateModuleOrNamespaceType (signatureData: ModuleOrNamespaceType) =
126+
for e in signatureData.ModuleAndNamespaceDefinitions do
127+
updateEntity e
128+
109129
let BindTypar env (tp: Typar) =
110130
{ env with
111131
boundTyparNames = tp.Name :: env.boundTyparNames
@@ -2597,6 +2617,7 @@ and CheckModuleSpec cenv env mbind =
25972617
let CheckImplFileContents cenv env implFileTy implFileContents =
25982618
let rpi, mhi = ComputeRemappingFromImplementationToSignature cenv.g implFileContents implFileTy
25992619
let env = { env with sigToImplRemapInfo = (mkRepackageRemapping rpi, mhi) :: env.sigToImplRemapInfo }
2620+
UpdatePrettyTyparNames.updateModuleOrNamespaceType implFileTy
26002621
CheckDefnInModule cenv env implFileContents
26012622

26022623
let CheckImplFile (g, amap, reportErrors, infoReader, internalsVisibleToPaths, viewCcu, tcValF, denv, implFileTy, implFileContents, extraAttribs, isLastCompiland: bool*bool, isInternalTestSpanStackReferring) =

‎tests/FSharp.Compiler.ComponentTests/TypeChecks/TyparNameTests.fs‎

Lines changed: 48 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,26 @@ open Xunit
55
open FSharp.Test
66
open FSharp.Test.Compiler
77

8+
let private getGenericParametersNamesFor
9+
(cUnit: CompilationUnit)
10+
(entityDisplayName: string)
11+
(valueDisplayName: string)
12+
(additionalFile: SourceCodeFileKind)
13+
: string array =
14+
let typeCheckResult =
15+
cUnit |> withAdditionalSourceFile additionalFile |> typecheckProject
16+
17+
typeCheckResult.AssemblySignature.Entities
18+
|> Seq.tryPick (fun (entity: FSharpEntity) ->
19+
if entity.DisplayName <> entityDisplayName then
20+
None
21+
else
22+
entity.MembersFunctionsAndValues
23+
|> Seq.tryFind (fun mfv -> mfv.DisplayName = valueDisplayName)
24+
|> Option.map (fun (mfv: FSharpMemberOrFunctionOrValue) ->
25+
mfv.GenericParameters |> Seq.map (fun gp -> gp.DisplayName) |> Seq.toArray))
26+
|> Option.defaultValue Array.empty
27+
828
[<Fact>]
929
let ``The call site of a generic function should have no influence on the name of the type parameters`` () =
1030
let definitionFile =
@@ -26,26 +46,8 @@ let otherGenericFunction _ _ _ =
2646
|> FsSource)
2747
.WithFileName("B.fs")
2848

29-
let getGenericParametersNamesFor
30-
(entityDisplayName: string)
31-
(valueDisplayName: string)
32-
(additionalFile: SourceCodeFileKind)
33-
: string array =
34-
let typeCheckResult =
35-
definitionFile |> withAdditionalSourceFile additionalFile |> typecheckProject
36-
37-
typeCheckResult.AssemblySignature.Entities
38-
|> Seq.tryPick (fun (entity: FSharpEntity) ->
39-
if entity.DisplayName <> entityDisplayName then
40-
None
41-
else
42-
entity.MembersFunctionsAndValues
43-
|> Seq.tryFind (fun mfv -> mfv.DisplayName = valueDisplayName)
44-
|> Option.map (fun (mfv: FSharpMemberOrFunctionOrValue) ->
45-
mfv.GenericParameters |> Seq.map (fun gp -> gp.DisplayName) |> Seq.toArray))
46-
|> Option.defaultValue Array.empty
47-
48-
let namesForB = getGenericParametersNamesFor "A" "someGenericFunction" usageFile
49+
let namesForB =
50+
getGenericParametersNamesFor definitionFile "A" "someGenericFunction" usageFile
4951

5052
let alternativeUsageFile =
5153
("""
@@ -58,6 +60,31 @@ let alternateGenericFunction _ =
5860
.WithFileName("C.fs")
5961

6062
let namesForC =
61-
getGenericParametersNamesFor "A" "someGenericFunction" alternativeUsageFile
63+
getGenericParametersNamesFor definitionFile "A" "someGenericFunction" alternativeUsageFile
6264

6365
Assert.Equal<string array>(namesForB, namesForC)
66+
67+
[<Fact>]
68+
let ``Fixed typar name in signature file is still respected`` () =
69+
let signatureFile =
70+
Fsi
71+
"""
72+
module A
73+
74+
val someGenericFunction: 'x -> unit
75+
"""
76+
|> withFileName "A.fsi"
77+
78+
let implementationFile =
79+
("""
80+
module A
81+
82+
let someGenericFunction _ = ()
83+
"""
84+
|> FsSource)
85+
.WithFileName("A.fs")
86+
87+
let names =
88+
getGenericParametersNamesFor signatureFile "A" "someGenericFunction" implementationFile
89+
90+
Assert.Equal<string array>([| "x" |], names)

0 commit comments

Comments
 (0)