From f725638af745a5d35b90342579b8ec01e2cff0ca Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Fri, 24 Oct 2025 09:15:56 +0200 Subject: [PATCH 01/17] generated names --- src/Compiler/Driver/OptimizeInputs.fs | 3 +-- src/Compiler/Driver/ParseAndCheckInputs.fs | 3 +-- src/Compiler/TypedTree/CompilerGlobalState.fs | 7 ++++--- 3 files changed, 6 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Driver/OptimizeInputs.fs b/src/Compiler/Driver/OptimizeInputs.fs index c79af5b33bc..ba76b966640 100644 --- a/src/Compiler/Driver/OptimizeInputs.fs +++ b/src/Compiler/Driver/OptimizeInputs.fs @@ -512,12 +512,11 @@ let ApplyAllOptimizations let results, optEnvFirstLoop = match tcConfig.optSettings.processingMode with // Parallel optimization breaks determinism - turn it off in deterministic builds. - | Optimizer.OptimizationProcessingMode.Parallel when (not tcConfig.deterministic) -> + | Optimizer.OptimizationProcessingMode.Parallel -> let results, optEnvFirstPhase = ParallelOptimization.optimizeFilesInParallel optEnv phases implFiles results |> Array.toList, optEnvFirstPhase - | Optimizer.OptimizationProcessingMode.Parallel | Optimizer.OptimizationProcessingMode.Sequential -> optimizeFilesSequentially optEnv phases implFiles #if DEBUG diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 518b99bdf84..b65eb02e0ba 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1883,8 +1883,7 @@ let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tc match tcConfig.typeCheckingConfig.Mode with | TypeCheckingMode.Graph when (not tcConfig.isInteractive - && not tcConfig.compilingFSharpCore - && not tcConfig.deterministic) + && not tcConfig.compilingFSharpCore) -> CheckMultipleInputsUsingGraphMode( ctok, diff --git a/src/Compiler/TypedTree/CompilerGlobalState.fs b/src/Compiler/TypedTree/CompilerGlobalState.fs index 12dda2b08d8..167dc55cdf9 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fs +++ b/src/Compiler/TypedTree/CompilerGlobalState.fs @@ -18,12 +18,13 @@ open FSharp.Compiler.Text /// policy to make all globally-allocated objects concurrency safe in case future versions of the compiler /// are used to host multiple concurrent instances of compilation. type NiceNameGenerator() = - let basicNameCounts = ConcurrentDictionary(max Environment.ProcessorCount 1, 127) + let basicNameCounts = ConcurrentDictionary(max Environment.ProcessorCount 1, 127) // Cache this as a delegate. - let basicNameCountsAddDelegate = Func(fun _ -> ref 0) + let basicNameCountsAddDelegate = Func(fun _ -> ref 0) member _.FreshCompilerGeneratedNameOfBasicName (basicName, m: range) = - let countCell = basicNameCounts.GetOrAdd(basicName, basicNameCountsAddDelegate) + let key = struct (basicName, m.FileIndex) + let countCell = basicNameCounts.GetOrAdd(key, basicNameCountsAddDelegate) let count = Interlocked.Increment(countCell) CompilerGeneratedNameSuffix basicName (string m.StartLine + (match (count-1) with 0 -> "" | n -> "-" + string n)) From 3cd1abff3c678d1f43081733ad08e86bd5d8710d Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Fri, 24 Oct 2025 09:24:55 +0200 Subject: [PATCH 02/17] fantomas --- src/Compiler/Driver/ParseAndCheckInputs.fs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index b65eb02e0ba..3fb4ba6922c 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1881,10 +1881,7 @@ let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tc // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions let results, tcState = match tcConfig.typeCheckingConfig.Mode with - | TypeCheckingMode.Graph when - (not tcConfig.isInteractive - && not tcConfig.compilingFSharpCore) - -> + | TypeCheckingMode.Graph when (not tcConfig.isInteractive && not tcConfig.compilingFSharpCore) -> CheckMultipleInputsUsingGraphMode( ctok, checkForErrors, From 1c7319633307f665cfb8fac614a548caadf7102e Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Fri, 24 Oct 2025 11:33:01 +0200 Subject: [PATCH 03/17] try to sort out pdb --- src/Compiler/AbstractIL/ilwritepdb.fs | 39 ++++++++++++++++++--------- 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/src/Compiler/AbstractIL/ilwritepdb.fs b/src/Compiler/AbstractIL/ilwritepdb.fs index bc3dbf18adc..7b7ae97f1d1 100644 --- a/src/Compiler/AbstractIL/ilwritepdb.fs +++ b/src/Compiler/AbstractIL/ilwritepdb.fs @@ -343,9 +343,13 @@ let scopeSorter (scope1: PdbMethodScope) (scope2: PdbMethodScope) = type PortablePdbGenerator (embedAllSource: bool, embedSourceList: string list, sourceLink: string, checksumAlgorithm, info: PdbData, pathMap: PathMap) = - let docs = info.Documents + // Deterministic: build the Document table in a stable order by mapped file path, + // but preserve the original-document-index -> handle mapping by filename. + let originalDocFiles = info.Documents |> Array.map (fun d -> d.File) - // The metadata to wite to the PortablePDB (Roslyn = _debugMetadataOpt) + let docsSorted = + info.Documents + |> Array.sortBy (fun d -> PathMap.apply pathMap d.File) let metadata = MetadataBuilder() @@ -418,15 +422,13 @@ type PortablePdbGenerator Some(builder.ToImmutableArray()) + // Build Document table in deterministic order let documentIndex = - let mutable index = Dictionary(docs.Length) - - let docLength = docs.Length + if String.IsNullOrEmpty sourceLink then 1 else 0 - + let mutable index = Dictionary(docsSorted.Length) + let docLength = docsSorted.Length + (if String.IsNullOrWhiteSpace sourceLink then 0 else 1) metadata.SetCapacity(TableIndex.Document, docLength) - for doc in docs do - // For F# Interactive, file name 'stdin' gets generated for interactive inputs + for doc in docsSorted do let handle = match checkSum doc.File checksumAlgorithm with | Some(hashAlg, checkSum) -> @@ -476,11 +478,12 @@ type PortablePdbGenerator let mutable lastLocalVariableHandle = Unchecked.defaultof + // IMPORTANT: map original document index -> filename -> handle let getDocumentHandle d = - if docs.Length = 0 || d < 0 || d > docs.Length then + if info.Documents.Length = 0 || d < 0 || d >= info.Documents.Length then Unchecked.defaultof else - match documentIndex.TryGetValue(docs[d].File) with + match documentIndex.TryGetValue(originalDocFiles[d]) with | false, _ -> Unchecked.defaultof | true, h -> h @@ -563,7 +566,16 @@ type PortablePdbGenerator let serializeImportsBlob (imports: PdbImport[]) = let writer = new BlobBuilder() - for import in imports do + let importsSorted = + imports + |> Array.sortWith (fun a b -> + match a, b with + | ImportType t1, ImportType t2 -> compare t1 t2 + | ImportNamespace n1, ImportNamespace n2 -> compare n1 n2 + | ImportType _, ImportNamespace _ -> -1 + | ImportNamespace _, ImportType _ -> 1) + + for import in importsSorted do serializeImport writer import metadata.GetOrAddBlob(writer) @@ -640,7 +652,8 @@ type PortablePdbGenerator ) |> ignore - for localVariable in scope.Locals do + // Deterministic: write locals by stable index + for localVariable in scope.Locals |> Array.sortBy (fun l -> l.Index) do lastLocalVariableHandle <- metadata.AddLocalVariable( LocalVariableAttributes.None, @@ -653,7 +666,7 @@ type PortablePdbGenerator let sps = match minfo.DebugRange with | None -> Array.empty - | Some _ -> minfo.DebugPoints + | Some _ -> minfo.DebugPoints |> Array.sortWith SequencePoint.orderByOffset let builder = BlobBuilder() builder.WriteCompressedInteger(minfo.LocalSignatureToken) From 128da519c7e511564185dbdddb30192e2128a93f Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Fri, 24 Oct 2025 16:09:00 +0200 Subject: [PATCH 04/17] 'char -> 'Char --- src/Compiler/SyntaxTree/UnicodeLexing.fs | 2 +- src/Compiler/SyntaxTree/UnicodeLexing.fsi | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fs b/src/Compiler/SyntaxTree/UnicodeLexing.fs index 4ea41cbcf84..fd342293211 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fs +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fs @@ -8,7 +8,7 @@ open Internal.Utilities.Text.Lexing type Lexbuf = LexBuffer -type LexBuffer<'char> with +type LexBuffer<'Char> with member lexbuf.GetLocalData<'T when 'T: not null>(key: string, initializer) = match lexbuf.BufferLocalStore.TryGetValue key with diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fsi b/src/Compiler/SyntaxTree/UnicodeLexing.fsi index ee722ee08c3..1ceae431ed3 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fsi +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fsi @@ -9,7 +9,7 @@ open Internal.Utilities.Text.Lexing type Lexbuf = LexBuffer -type LexBuffer<'char> with +type LexBuffer<'Char> with member GetLocalData<'T when 'T: not null> : key: string * initializer: (unit -> 'T) -> 'T member TryGetLocalData<'T when 'T: not null> : key: string -> 'T option From e1a4c93c6f6299f0626cd8502258e821400a67da Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Fri, 24 Oct 2025 16:45:58 +0200 Subject: [PATCH 05/17] update pdb test --- .../Debugger/PortablePdbs.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Debugger/PortablePdbs.fs b/tests/FSharp.Compiler.ComponentTests/Debugger/PortablePdbs.fs index 767d1f75670..5d44d059cf7 100644 --- a/tests/FSharp.Compiler.ComponentTests/Debugger/PortablePdbs.fs +++ b/tests/FSharp.Compiler.ComponentTests/Debugger/PortablePdbs.fs @@ -45,27 +45,27 @@ module Baz = [ { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft" } { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp" } - { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp.Core" } { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp.Collections" } { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp.Control" } + { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp.Core" } { Kind = ImportDefinitionKind.ImportNamespace; Name = "System" } ] [ { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft" } { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp" } - { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp.Core" } { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp.Collections" } { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp.Control" } + { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp.Core" } { Kind = ImportDefinitionKind.ImportNamespace; Name = "System.IO" } ] [ { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft" } { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp" } - { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp.Core" } { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp.Collections" } { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp.Control" } - { Kind = ImportDefinitionKind.ImportNamespace; Name = "System.IO" } + { Kind = ImportDefinitionKind.ImportNamespace; Name = "Microsoft.FSharp.Core" } { Kind = ImportDefinitionKind.ImportNamespace; Name = "System.Collections.Generic" } + { Kind = ImportDefinitionKind.ImportNamespace; Name = "System.IO" } ] ] VerifySequencePoints [ From da1e2b7cde9d9e45dd7ca5ae055ef54d3608191b Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Fri, 24 Oct 2025 16:46:34 +0200 Subject: [PATCH 06/17] format --- src/Compiler/AbstractIL/ilwritepdb.fs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Compiler/AbstractIL/ilwritepdb.fs b/src/Compiler/AbstractIL/ilwritepdb.fs index 7b7ae97f1d1..f78829e5cba 100644 --- a/src/Compiler/AbstractIL/ilwritepdb.fs +++ b/src/Compiler/AbstractIL/ilwritepdb.fs @@ -348,8 +348,7 @@ type PortablePdbGenerator let originalDocFiles = info.Documents |> Array.map (fun d -> d.File) let docsSorted = - info.Documents - |> Array.sortBy (fun d -> PathMap.apply pathMap d.File) + info.Documents |> Array.sortBy (fun d -> PathMap.apply pathMap d.File) let metadata = MetadataBuilder() @@ -425,7 +424,10 @@ type PortablePdbGenerator // Build Document table in deterministic order let documentIndex = let mutable index = Dictionary(docsSorted.Length) - let docLength = docsSorted.Length + (if String.IsNullOrWhiteSpace sourceLink then 0 else 1) + + let docLength = + docsSorted.Length + (if String.IsNullOrWhiteSpace sourceLink then 0 else 1) + metadata.SetCapacity(TableIndex.Document, docLength) for doc in docsSorted do From 277a6dc643aa48226b0efff7a97de6aa5a8822a1 Mon Sep 17 00:00:00 2001 From: majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 25 Oct 2025 15:13:21 +0200 Subject: [PATCH 07/17] add valid scenarios for fsi after fs and script mode compilation --- .../TypeChecks/Graph/Scenarios.fs | 144 ++++++++++++++++++ 1 file changed, 144 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs index 5126282048c..8c7e8e4e093 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs @@ -1085,4 +1085,148 @@ module Y = global.Z.N """ (set [| 0 |]) ] + // New scenario: signature file erroneously follows implementation + // We add a backward link from implementation to signature, to correctly trigger + // FS0238 (implementation already given). + + scenario + "Signature file follows implementation" + [ + sourceFile + "A.fs" + """ +module A + +let a x = x + 1 +""" + Set.empty + sourceFile + "B.fs" + """ +module B + +let b = A.a 42 +""" + (set [| 0 |]) + sourceFile + "A.fsi" + """ +module A + +val a: int -> int +""" + (set [| 0 |]) + ] + + // The .fsx script is placed in-between files to enforce a linear graph up to the script. + // After the script, normal dependency resolution resumes. + + scenario + "Script file uses modules across signatures (script in-between)" + [ + // 0 + sourceFile + "A.fsi" + """ +module A + +type AType = class end +""" + Set.empty + + // 1 + sourceFile + "A.fs" + """ +module A + +type AType = class end +""" + (set [| 0 |]) // sequential: depends on previous file due to script later + + // 2 + sourceFile + "B.fsi" + """ +module B + +open A + +val b: AType -> unit +""" + (set [| 1 |]) // sequential + + // 3 + sourceFile + "B.fs" + """ +module B + +open A + +let b (a: AType) = () +""" + (set [| 2 |]) // sequential + + // 4 (script in-between) + sourceFile + "Script.fsx" + """ +open A +open B + +let run (a: A.AType) = + B.b a +""" + (set [| 3 |]) // sequential + + // 5 + sourceFile + "C.fsi" + """ +module C + +type CType = class end +""" + Set.empty + + // 6 + sourceFile + "C.fs" + """ +module C + +type CType = class end +""" + (set [| 5 |]) // normal deps: impl to own signature + + // 7 + sourceFile + "D.fsi" + """ +module D + +open A +open C + +val d: CType -> unit +""" + (set [| 0; 5 |]) // normal deps: opens A (A.fsi=0) and C (C.fsi=5) + + // 8 + sourceFile + "D.fs" + """ +module D + +open A +open B +open C + +let d (c: CType) = + let a: AType = failwith "todo" + b a +""" + (set [| 0; 2; 5; 7 |]) // normal deps: A.fsi=0, B.fsi=2, C.fsi=5, plus own D.fsi=7 + ] ] \ No newline at end of file From b3b9e2fca5e74a65387aff91b49e9711f98281e8 Mon Sep 17 00:00:00 2001 From: majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 25 Oct 2025 15:28:35 +0200 Subject: [PATCH 08/17] improve naming, add comments for added misoreded implementation scenario --- .../Driver/GraphChecking/DependencyResolution.fs | 8 +++++--- src/Compiler/Driver/GraphChecking/Types.fs | 10 ++++++---- src/Compiler/Driver/GraphChecking/Types.fsi | 4 +++- 3 files changed, 14 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs index 2f0b4626152..fd2e0e2ffc9 100644 --- a/src/Compiler/Driver/GraphChecking/DependencyResolution.fs +++ b/src/Compiler/Driver/GraphChecking/DependencyResolution.fs @@ -236,8 +236,10 @@ let mkGraph (filePairs: FilePairMap) (files: FileInProject array) : Graph Array.empty | Some sigIdx -> Array.singleton sigIdx - let wrongOrderSignature = - match filePairs.TryGetWrongOrderSignatureToImplementationIndex file.Idx with + // Add a link from signature files to their implementation files, if the implementation file comes before the signature file. + // This allows us to emit FS0238 (implementation already given). + let implementationGivenBeforeSignature = + match filePairs.TryGetOutOfOrderImplementationIndex file.Idx with | None -> Array.empty | Some idx -> Array.singleton idx @@ -246,7 +248,7 @@ let mkGraph (filePairs: FilePairMap) (files: FileInProject array) : Graph Array.distinct diff --git a/src/Compiler/Driver/GraphChecking/Types.fs b/src/Compiler/Driver/GraphChecking/Types.fs index a00f7626f08..3d35fab20bb 100644 --- a/src/Compiler/Driver/GraphChecking/Types.fs +++ b/src/Compiler/Driver/GraphChecking/Types.fs @@ -173,13 +173,14 @@ type internal FilePairMap(files: FileInProject array) = |> Option.map (fun (implFile: FileInProject) -> (sigFile.Idx, implFile.Idx))) |> Array.choose id - let goodPairs, wrongOrderPairs = + let goodPairs, misorderedPairs = pairs |> Array.partition (fun (sigIdx, implIdx) -> sigIdx < implIdx) let sigToImpl, implToSig = buildBiDirectionalMaps goodPairs - // Pairs where the signature file comes after the implementation file in the project order. We need to track them to report such errors. - let wrongOrder = wrongOrderPairs |> Map.ofArray + // Pairs where the signature file comes after the implementation file in the project order. + // We need to track them to report FS0238 (implementation already given). + let misordered = misorderedPairs |> Map.ofArray member x.GetSignatureIndex(implementationIndex: FileIndex) = Map.find implementationIndex implToSig member x.GetImplementationIndex(signatureIndex: FileIndex) = Map.find signatureIndex sigToImpl @@ -195,7 +196,8 @@ type internal FilePairMap(files: FileInProject array) = member x.IsSignature(index: FileIndex) = Map.containsKey index sigToImpl - member x.TryGetWrongOrderSignatureToImplementationIndex(index: FileIndex) = wrongOrder |> Map.tryFind index + member x.TryGetOutOfOrderImplementationIndex(signatureIndex: FileIndex) = + misordered |> Map.tryFind signatureIndex /// Callback that returns a previously calculated 'Result and updates 'State accordingly. type internal Finisher<'Node, 'State, 'Result> = Finisher of node: 'Node * finisher: ('State -> 'Result * 'State) diff --git a/src/Compiler/Driver/GraphChecking/Types.fsi b/src/Compiler/Driver/GraphChecking/Types.fsi index 6a529b104ab..9224c154ccf 100644 --- a/src/Compiler/Driver/GraphChecking/Types.fsi +++ b/src/Compiler/Driver/GraphChecking/Types.fsi @@ -117,7 +117,9 @@ type internal FilePairMap = member HasSignature: implementationIndex: FileIndex -> bool member TryGetSignatureIndex: implementationIndex: FileIndex -> FileIndex option member IsSignature: index: FileIndex -> bool - member TryGetWrongOrderSignatureToImplementationIndex: index: FileIndex -> FileIndex option + /// Covers the case where the implementation file appears before the signature file in the project. + /// This is needed only to correctly trigger FS0238 (implementation already given). + member TryGetOutOfOrderImplementationIndex: signatureIndex: FileIndex -> FileIndex option /// Callback that returns a previously calculated 'Result and updates 'State accordingly. type internal Finisher<'Node, 'State, 'Result> = Finisher of node: 'Node * finisher: ('State -> 'Result * 'State) From 252dd095fc290d2089bb922265d82c647cedc725 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 25 Oct 2025 20:46:26 +0200 Subject: [PATCH 09/17] fix tests --- .../TypeChecks/Graph/CompilationTests.fs | 37 +++- .../TypeChecks/Graph/Scenarios.fs | 178 ++++-------------- 2 files changed, 64 insertions(+), 151 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs index 4142b10565f..9cd1fe0ea6b 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs @@ -12,8 +12,8 @@ type Method = let methodOptions (method: Method) = match method with - | Method.Sequential -> [] - | Method.Graph -> [ "--test:GraphBasedChecking"; "--test:DumpCheckingGraph" ] + | Method.Sequential -> ["--parallelcompilation-"] + | Method.Graph -> ["--test:DumpCheckingGraph"] let withMethod (method: Method) (cu: CompilationUnit) : CompilationUnit = match cu with @@ -24,7 +24,7 @@ let withMethod (method: Method) (cu: CompilationUnit) : CompilationUnit = } | cu -> cu -let compileAValidScenario (scenario: Scenario) (method: Method) = +let compileScenario (scenario: Scenario) (method: Method) = let cUnit = let files = scenario.Files @@ -36,21 +36,44 @@ let compileAValidScenario (scenario: Scenario) (method: Method) = let f = fsFromString first |> FS f |> withAdditionalSourceFiles rest + let dir = TestFramework.createTemporaryDirectory() + + printfn "Compiling scenario '%s' \nin directory %s" scenario.Name dir.FullName + cUnit + |> withName scenario.Name + |> withOutputDirectory (Some dir) + |> ignoreWarnings |> withOutputType CompileOutput.Library |> withMethod method |> compile - |> shouldSucceed - |> ignore let scenarios = scenarios |> List.map (fun c -> [| box c |]) [] [] let ``Compile a valid scenario using graph-based type-checking`` (scenario) = - compileAValidScenario scenario Method.Graph + compileScenario scenario Method.Graph + |> shouldSucceed + |> ignore [] [] let ``Compile a valid scenario using sequential type-checking`` (scenario) = - compileAValidScenario scenario Method.Sequential + compileScenario scenario Method.Sequential + |> shouldSucceed + |> ignore + +[] +let ``Compile misordered scenario using graph-based type-checking fails`` () = + compileScenario misorderedScenario Method.Graph + |> shouldFail + |> withErrorCodes [238; 248] + |> ignore + +[] +let ``Compile misordered scenario using sequential type-checking fails`` () = + compileScenario misorderedScenario Method.Sequential + |> shouldFail + |> withErrorCodes [238; 248] + |> ignore diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs index 8c7e8e4e093..fe055f2e4d0 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs @@ -1085,148 +1085,38 @@ module Y = global.Z.N """ (set [| 0 |]) ] - // New scenario: signature file erroneously follows implementation - // We add a backward link from implementation to signature, to correctly trigger - // FS0238 (implementation already given). - scenario - "Signature file follows implementation" - [ - sourceFile - "A.fs" - """ -module A - -let a x = x + 1 -""" - Set.empty - sourceFile - "B.fs" - """ -module B - -let b = A.a 42 -""" - (set [| 0 |]) - sourceFile - "A.fsi" - """ -module A - -val a: int -> int -""" - (set [| 0 |]) - ] - - // The .fsx script is placed in-between files to enforce a linear graph up to the script. - // After the script, normal dependency resolution resumes. - - scenario - "Script file uses modules across signatures (script in-between)" - [ - // 0 - sourceFile - "A.fsi" - """ -module A - -type AType = class end -""" - Set.empty - - // 1 - sourceFile - "A.fs" - """ -module A - -type AType = class end -""" - (set [| 0 |]) // sequential: depends on previous file due to script later - - // 2 - sourceFile - "B.fsi" - """ -module B - -open A - -val b: AType -> unit -""" - (set [| 1 |]) // sequential - - // 3 - sourceFile - "B.fs" - """ -module B - -open A - -let b (a: AType) = () -""" - (set [| 2 |]) // sequential - - // 4 (script in-between) - sourceFile - "Script.fsx" - """ -open A -open B - -let run (a: A.AType) = - B.b a -""" - (set [| 3 |]) // sequential - - // 5 - sourceFile - "C.fsi" - """ -module C - -type CType = class end -""" - Set.empty - - // 6 - sourceFile - "C.fs" - """ -module C - -type CType = class end -""" - (set [| 5 |]) // normal deps: impl to own signature - - // 7 - sourceFile - "D.fsi" - """ -module D - -open A -open C - -val d: CType -> unit -""" - (set [| 0; 5 |]) // normal deps: opens A (A.fsi=0) and C (C.fsi=5) - - // 8 - sourceFile - "D.fs" - """ -module D - -open A -open B -open C - -let d (c: CType) = - let a: AType = failwith "todo" - b a -""" - (set [| 0; 2; 5; 7 |]) // normal deps: A.fsi=0, B.fsi=2, C.fsi=5, plus own D.fsi=7 - ] - ] \ No newline at end of file + ] + +let internal misorderedScenario = + // New scenario: signature file erroneously follows implementation + // We add a backward link from implementation to signature, to correctly trigger + // FS0238 (implementation already given). + scenario + "Signature file follows implementation" + [ + sourceFile + "A.fs" + """ + module A + + let a x = x + 1 + """ + Set.empty + sourceFile + "B.fs" + """ + module B + + let b = A.a 42 + """ + (set [| 0 |]) + sourceFile + "A.fsi" + """ + module A + + val a: int -> int + """ + (set [| 0 |]) + ] \ No newline at end of file From 43f0a7895fd8cd226edaa4babd30980a42f8d377 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sat, 25 Oct 2025 21:49:04 +0200 Subject: [PATCH 10/17] add script mode test --- .../TypeChecks/Graph/CompilationTests.fs | 2 +- .../Graph/DependencyResolutionTests.fs | 2 +- .../TypeChecks/Graph/Scenarios.fs | 67 +++++++++++++++++++ 3 files changed, 69 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs index 9cd1fe0ea6b..4b95782bfbc 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs @@ -48,7 +48,7 @@ let compileScenario (scenario: Scenario) (method: Method) = |> withMethod method |> compile -let scenarios = scenarios |> List.map (fun c -> [| box c |]) +let scenarios = scriptCompilationScenario :: scenarios |> List.map (fun c -> [| box c |]) [] [] diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/DependencyResolutionTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/DependencyResolutionTests.fs index 81adc540766..334c76b94f1 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/DependencyResolutionTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/DependencyResolutionTests.fs @@ -5,7 +5,7 @@ open Xunit open FSharp.Compiler.GraphChecking open Scenarios -let scenarios = scenarios |> Seq.map (fun p -> [| box p |]) +let scenarios = scriptCompilationScenario :: misorderedScenario :: scenarios |> Seq.map (fun p -> [| box p |]) [] [] diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs index fe055f2e4d0..cbce8681bd9 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs @@ -1119,4 +1119,71 @@ let internal misorderedScenario = val a: int -> int """ (set [| 0 |]) + ] + +let internal scriptCompilationScenario = + scenario + "Script compilation with #load and downstream files" + [ + sourceFile + "A.fs" + """ +module LibA + +type A = { Value: int } + +let inc x = x + 1 +""" + Set.empty + sourceFile + "B.fs" + """ +module LibB + +let append s i = s + string i +""" + (set [| 0 |]) + sourceFile + "Run.fsx" + """ +namespace Script + +#load "A.fs" +#load "B.fs" + +open LibA +open LibB + +module ScriptModule = + let compute s = + let a = inc 41 + append s a +""" + (set [| 1 |]) + sourceFile + "Independent.fs" + """ +module Independent + +let z = 0 +""" + Set.empty + sourceFile + "DependsOnScript.fs" + """ +module Consumer + +open Script.ScriptModule + +let result = compute "ok" +""" + (set [| 2 |]) + sourceFile + "AlsoDependsOnScript.fs" + """ +module AnotherConsumer + +let value = Script.ScriptModule.compute "hi" +""" + (set [| 2 |]) ] \ No newline at end of file From 7336f290280bb33a790dcec514a15d40610ea038 Mon Sep 17 00:00:00 2001 From: majocha <1760221+majocha@users.noreply.github.com> Date: Sun, 26 Oct 2025 09:42:51 +0100 Subject: [PATCH 11/17] release notes --- docs/release-notes/.FSharp.Compiler.Service/11.0.0.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) 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 655ad02ad2a..800b325607a 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md @@ -11,6 +11,8 @@ ### Changed -* Parallel compilation stabilised and enabled by default ([PR #18998](https://github.com/dotnet/fsharp/pull/18998)) +* Parallel compilation features: ref resolution, graph based checking, ILXGen and optimization enabled by default ([PR #18998](https://github.com/dotnet/fsharp/pull/18998)) +* Make graph based type checking and parallel optimizations deterministic ([PR #19028](https://github.com/dotnet/fsharp/pull/19028)) + ### Breaking Changes \ No newline at end of file From 0c4e421a4b20c86d585c6b3813cf95e0e9ceb241 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sun, 26 Oct 2025 20:35:01 +0100 Subject: [PATCH 12/17] disable typar ident overwrite in extensions when deterministic --- src/Compiler/Checking/CheckDeclarations.fs | 3 ++- src/Compiler/Driver/CompilerImports.fs | 1 + src/Compiler/Service/IncrementalBuild.fs | 1 + src/Compiler/SyntaxTree/UnicodeLexing.fs | 2 +- src/Compiler/SyntaxTree/UnicodeLexing.fsi | 2 +- src/Compiler/TypedTree/TcGlobals.fs | 3 +++ src/Compiler/TypedTree/TcGlobals.fsi | 3 +++ 7 files changed, 12 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index cbf79fbdfb3..5095cd645e4 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4218,7 +4218,8 @@ module TcDeclarations = | Result res -> // Update resolved type parameters with the names from the source. let _, tcref, _ = res - if tcref.TyparsNoRange.Length = synTypars.Length then + + if (not g.deterministic) && tcref.TyparsNoRange.Length = synTypars.Length then (tcref.TyparsNoRange, synTypars) ||> List.zip |> List.iter (fun (typar, SynTyparDecl.SynTyparDecl (typar = tp)) -> diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 3fc933540a7..54a037acd13 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2606,6 +2606,7 @@ and [] TcImports tcConfig.pathMap, tcConfig.langVersion, tcConfig.realsig, + tcConfig.deterministic, tcConfig.compilationMode ) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 6db19653f9a..6844adccbdb 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -573,6 +573,7 @@ type FrameworkImportsCache(size) = tcGlobals.pathMap, tcConfig.langVersion, tcConfig.realsig, + tcConfig.deterministic, tcConfig.compilationMode ) diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fs b/src/Compiler/SyntaxTree/UnicodeLexing.fs index fd342293211..4ea41cbcf84 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fs +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fs @@ -8,7 +8,7 @@ open Internal.Utilities.Text.Lexing type Lexbuf = LexBuffer -type LexBuffer<'Char> with +type LexBuffer<'char> with member lexbuf.GetLocalData<'T when 'T: not null>(key: string, initializer) = match lexbuf.BufferLocalStore.TryGetValue key with diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fsi b/src/Compiler/SyntaxTree/UnicodeLexing.fsi index 1ceae431ed3..ee722ee08c3 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fsi +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fsi @@ -9,7 +9,7 @@ open Internal.Utilities.Text.Lexing type Lexbuf = LexBuffer -type LexBuffer<'Char> with +type LexBuffer<'char> with member GetLocalData<'T when 'T: not null> : key: string * initializer: (unit -> 'T) -> 'T member TryGetLocalData<'T when 'T: not null> : key: string -> 'T option diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 9999b801606..06814e81f46 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -198,6 +198,7 @@ type TcGlobals( pathMap: PathMap, langVersion: LanguageVersion, realsig: bool, + deterministic: bool, compilationMode: CompilationMode) = let v_langFeatureNullness = langVersion.SupportsFeature LanguageFeature.NullnessChecking @@ -1847,6 +1848,8 @@ type TcGlobals( /// Are we assuming all code gen is for F# interactive, with no static linking member _.isInteractive=isInteractive + member val deterministic = deterministic + member val compilationMode = compilationMode /// Indicates if we are generating witness arguments for SRTP constraints. Only done if the FSharp.Core diff --git a/src/Compiler/TypedTree/TcGlobals.fsi b/src/Compiler/TypedTree/TcGlobals.fsi index f4b866d8fbc..d443b278a04 100644 --- a/src/Compiler/TypedTree/TcGlobals.fsi +++ b/src/Compiler/TypedTree/TcGlobals.fsi @@ -157,6 +157,7 @@ type internal TcGlobals = pathMap: Internal.Utilities.PathMap * langVersion: FSharp.Compiler.Features.LanguageVersion * realsig: bool * + deterministic: bool * compilationMode: CompilationMode -> TcGlobals @@ -826,6 +827,8 @@ type internal TcGlobals = /// Are we assuming all code gen is for F# interactive, with no static linking member isInteractive: bool + member deterministic: bool + member compilationMode: CompilationMode member isnull_info: IntrinsicValRef From c032cc37adbab31c722e6e51696d5b4a81d5a535 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sun, 26 Oct 2025 20:35:25 +0100 Subject: [PATCH 13/17] deterministic parallel ilxgen --- src/Compiler/CodeGen/IlxGen.fs | 29 +++++++++++++++---- src/Compiler/Driver/OptimizeInputs.fs | 2 +- src/Compiler/TypedTree/CompilerGlobalState.fs | 14 +++++---- .../TypedTree/CompilerGlobalState.fsi | 1 + 4 files changed, 34 insertions(+), 12 deletions(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 7c917fbfa9a..5b79e297a76 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -368,6 +368,8 @@ type CompileLocation = Enclosing: string list QualifiedNameOfFile: string + + Range: range } //-------------------------------------------------------------------------- @@ -388,6 +390,7 @@ let CompLocForFragment fragName (ccu: CcuThunk) = Scope = ccu.ILScopeRef Namespace = None Enclosing = [] + Range = range0 } let CompLocForCcu (ccu: CcuThunk) = CompLocForFragment ccu.AssemblyName ccu @@ -406,7 +409,7 @@ let CompLocForSubModuleOrNamespace cloc (submod: ModuleOrNamespace) = Namespace = Some(mkTopName cloc.Namespace n) } -let CompLocForFixedPath fragName qname (CompPath(sref, _, cpath)) = +let CompLocForFixedPath fragName qname m (CompPath(sref, _, cpath)) = let ns, t = cpath |> List.takeUntil (fun (_, mkind) -> @@ -425,10 +428,11 @@ let CompLocForFixedPath fragName qname (CompPath(sref, _, cpath)) = Scope = sref Namespace = ns Enclosing = encl + Range = m } let CompLocForFixedModule fragName qname (mspec: ModuleOrNamespace) = - let cloc = CompLocForFixedPath fragName qname mspec.CompilationPath + let cloc = CompLocForFixedPath fragName qname mspec.Range mspec.CompilationPath let cloc = CompLocForSubModuleOrNamespace cloc mspec cloc @@ -2333,8 +2337,11 @@ and AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbuf MemoizationTable( "rawDataValueTypeGenerator", (fun (cloc, size) -> - let name = - CompilerGeneratedName("T" + string (newUnique ()) + "_" + string size + "Bytes") // Type names ending ...$T_37Bytes + + let unique = + g.CompilerGlobalState.Value.IlxGenNiceNameGenerator.IncrementOnly("@T", cloc.Range) + + let name = CompilerGeneratedName $"T{unique}_{size}Bytes" // Type names ending ...$T_37Bytes let vtdef = mkRawDataValueTypeDef g.iltyp_ValueType (name, size, 0us) let vtref = NestedTypeRefForCompLoc cloc vtdef.Name @@ -2390,7 +2397,12 @@ and AssemblyBuilder(cenv: cenv, anonTypeTable: AnonTypeGenerationTable) as mgbuf // Byte array literals require a ValueType of size the required number of bytes. // With fsi.exe, S.R.Emit TypeBuilder CreateType has restrictions when a ValueType VT is nested inside a type T, and T has a field of type VT. // To avoid this situation, these ValueTypes are generated under the private implementation rather than in the current cloc. [was bug 1532]. - let cloc = CompLocForPrivateImplementationDetails cloc + let cloc = + if cenv.options.isInteractive then + CompLocForPrivateImplementationDetails cloc + else + cloc + rawDataValueTypeGenerator.Apply((cloc, size)) member _.GenerateAnonType(genToStringMethod, anonInfo: AnonRecdTypeInfo) = @@ -2754,7 +2766,11 @@ let GenConstArray cenv (cgbuf: CodeGenBuffer) eenv ilElementType (data: 'a[]) (w CG.EmitInstrs cgbuf (pop 0) (Push [ ilArrayType ]) [ mkLdcInt32 0; I_newarr(ILArrayShape.SingleDimensional, ilElementType) ] else let vtspec = cgbuf.mgbuf.GenerateRawDataValueType(eenv.cloc, bytes.Length) - let ilFieldName = CompilerGeneratedName("field" + string (newUnique ())) + //let fi = eenv.cloc.Range.FileIndex + let unique = + g.CompilerGlobalState.Value.IlxGenNiceNameGenerator.IncrementOnly("@field", eenv.cloc.Range) + + let ilFieldName = CompilerGeneratedName $"field{unique}" let fty = ILType.Value vtspec let ilFieldDef = @@ -10417,6 +10433,7 @@ and GenImplFile cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (implFile: Checke cloc = { eenv.cloc with TopImplQualifiedName = qname.Text + Range = m } } diff --git a/src/Compiler/Driver/OptimizeInputs.fs b/src/Compiler/Driver/OptimizeInputs.fs index ba76b966640..78bca4bf979 100644 --- a/src/Compiler/Driver/OptimizeInputs.fs +++ b/src/Compiler/Driver/OptimizeInputs.fs @@ -577,7 +577,7 @@ let GenerateIlxCode isInteractive = tcConfig.isInteractive isInteractiveItExpr = isInteractiveItExpr alwaysCallVirt = tcConfig.alwaysCallVirt - parallelIlxGenEnabled = tcConfig.parallelIlxGen && not tcConfig.deterministic + parallelIlxGenEnabled = tcConfig.parallelIlxGen } ilxGenerator.GenerateCode(ilxGenOpts, optimizedImpls, topAttrs.assemblyAttrs, topAttrs.netModuleAttrs) diff --git a/src/Compiler/TypedTree/CompilerGlobalState.fs b/src/Compiler/TypedTree/CompilerGlobalState.fs index 167dc55cdf9..4a73e26e73c 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fs +++ b/src/Compiler/TypedTree/CompilerGlobalState.fs @@ -21,17 +21,21 @@ type NiceNameGenerator() = let basicNameCounts = ConcurrentDictionary(max Environment.ProcessorCount 1, 127) // Cache this as a delegate. let basicNameCountsAddDelegate = Func(fun _ -> ref 0) - - member _.FreshCompilerGeneratedNameOfBasicName (basicName, m: range) = + + let increment basicName (m: range) = let key = struct (basicName, m.FileIndex) let countCell = basicNameCounts.GetOrAdd(key, basicNameCountsAddDelegate) - let count = Interlocked.Increment(countCell) - - CompilerGeneratedNameSuffix basicName (string m.StartLine + (match (count-1) with 0 -> "" | n -> "-" + string n)) + Interlocked.Increment(countCell) + + member _.FreshCompilerGeneratedNameOfBasicName (basicName, m: range) = + let count = increment basicName m + CompilerGeneratedNameSuffix basicName (string m.StartLine + (match (count - 1) with 0 -> "" | n -> "-" + string n)) member this.FreshCompilerGeneratedName (name, m: range) = this.FreshCompilerGeneratedNameOfBasicName (GetBasicNameOfPossibleCompilerGeneratedName name, m) + member _.IncrementOnly(name: string, m: range) = increment name m + /// Generates compiler-generated names marked up with a source code location, but if given the same unique value then /// return precisely the same name. Each name generated also includes the StartLine number of the range passed in /// at the point of first generation. diff --git a/src/Compiler/TypedTree/CompilerGlobalState.fsi b/src/Compiler/TypedTree/CompilerGlobalState.fsi index 6f0dba79ddf..b308cbe25a7 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fsi +++ b/src/Compiler/TypedTree/CompilerGlobalState.fsi @@ -17,6 +17,7 @@ type NiceNameGenerator = new: unit -> NiceNameGenerator member FreshCompilerGeneratedName: name: string * m: range -> string + member IncrementOnly: name: string * m: range -> int /// Generates compiler-generated names marked up with a source code location, but if given the same unique value then /// return precisely the same name. Each name generated also includes the StartLine number of the range passed in From caebe816f7f2040daf1b9d02eddbca73ac453897 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 27 Oct 2025 19:39:36 +0100 Subject: [PATCH 14/17] clean up tests --- .../TypeChecks/Graph/CompilationTests.fs | 15 +- .../Graph/DependencyResolutionTests.fs | 2 +- .../TypeChecks/Graph/Scenarios.fs | 139 +++++++++--------- 3 files changed, 79 insertions(+), 77 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs index 4b95782bfbc..634e9fef7ea 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs @@ -48,21 +48,22 @@ let compileScenario (scenario: Scenario) (method: Method) = |> withMethod method |> compile -let scenarios = scriptCompilationScenario :: scenarios |> List.map (fun c -> [| box c |]) +let compileAValidScenario (scenario: Scenario) (method: Method) = + compileScenario scenario method + |> shouldSucceed + |> ignore + +let scenarios = compilingScenarios |> List.map (fun c -> [| box c |]) [] [] let ``Compile a valid scenario using graph-based type-checking`` (scenario) = - compileScenario scenario Method.Graph - |> shouldSucceed - |> ignore + compileAValidScenario scenario Method.Graph [] [] let ``Compile a valid scenario using sequential type-checking`` (scenario) = - compileScenario scenario Method.Sequential - |> shouldSucceed - |> ignore + compileAValidScenario scenario Method.Sequential [] let ``Compile misordered scenario using graph-based type-checking fails`` () = diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/DependencyResolutionTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/DependencyResolutionTests.fs index 334c76b94f1..81adc540766 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/DependencyResolutionTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/DependencyResolutionTests.fs @@ -5,7 +5,7 @@ open Xunit open FSharp.Compiler.GraphChecking open Scenarios -let scenarios = scriptCompilationScenario :: misorderedScenario :: scenarios |> Seq.map (fun p -> [| box p |]) +let scenarios = scenarios |> Seq.map (fun p -> [| box p |]) [] [] diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs index cbce8681bd9..424fc6d471e 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Scenarios.fs @@ -31,7 +31,7 @@ let private sourceFile fileName content (dependencies: Set) = Content = content } -let internal scenarios = +let internal compilingScenarios = [ scenario "Link via full open statement" @@ -1085,67 +1085,30 @@ module Y = global.Z.N """ (set [| 0 |]) ] - - ] - -let internal misorderedScenario = - // New scenario: signature file erroneously follows implementation - // We add a backward link from implementation to signature, to correctly trigger - // FS0238 (implementation already given). - scenario - "Signature file follows implementation" - [ - sourceFile - "A.fs" - """ - module A - - let a x = x + 1 - """ - Set.empty - sourceFile - "B.fs" - """ - module B - - let b = A.a 42 - """ - (set [| 0 |]) - sourceFile - "A.fsi" - """ - module A - - val a: int -> int - """ - (set [| 0 |]) - ] - -let internal scriptCompilationScenario = - scenario - "Script compilation with #load and downstream files" - [ - sourceFile - "A.fs" - """ + scenario + "Script compilation with #load and downstream files" + [ + sourceFile + "A.fs" + """ module LibA type A = { Value: int } let inc x = x + 1 """ - Set.empty - sourceFile - "B.fs" - """ + Set.empty + sourceFile + "B.fs" + """ module LibB let append s i = s + string i """ - (set [| 0 |]) - sourceFile - "Run.fsx" - """ + (set [| 0 |]) + sourceFile + "Run.fsx" + """ namespace Script #load "A.fs" @@ -1155,35 +1118,73 @@ open LibA open LibB module ScriptModule = - let compute s = - let a = inc 41 - append s a + let compute s = + let a = inc 41 + append s a """ - (set [| 1 |]) - sourceFile - "Independent.fs" - """ + (set [| 1 |]) + sourceFile + "Independent.fs" + """ module Independent let z = 0 """ - Set.empty - sourceFile - "DependsOnScript.fs" - """ + Set.empty + sourceFile + "DependsOnScript.fs" + """ module Consumer open Script.ScriptModule let result = compute "ok" """ - (set [| 2 |]) - sourceFile - "AlsoDependsOnScript.fs" - """ + (set [| 2 |]) + sourceFile + "AlsoDependsOnScript.fs" + """ module AnotherConsumer let value = Script.ScriptModule.compute "hi" """ - (set [| 2 |]) - ] \ No newline at end of file + (set [| 2 |]) + ] + ] + + +// Implementation given before signature file. This scenario will not compile, but is supported. +// Produced graph should have a necessary dependecy to trigger expected errors. +let internal misorderedScenario = + scenario + "Signature file follows implementation" + [ + sourceFile + "A.fs" + """ + module A + + let a x = x + 1 + """ + Set.empty + sourceFile + "B.fs" + """ + module B + + let b = A.a 42 + """ + (set [| 0 |]) + sourceFile + "A.fsi" + """ + module A + + val a: int -> int + """ + // We add a backward link from implementation to signature, to correctly trigger + // FS0238 (implementation already given). + (set [| 0 |]) + ] + +let internal scenarios = misorderedScenario :: compilingScenarios From 48f0f630ac9c479bb71370dd531127a6392391f0 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 27 Oct 2025 19:44:42 +0100 Subject: [PATCH 15/17] cleanup --- src/Compiler/CodeGen/IlxGen.fs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 5b79e297a76..b936bd0e9b9 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -2766,7 +2766,6 @@ let GenConstArray cenv (cgbuf: CodeGenBuffer) eenv ilElementType (data: 'a[]) (w CG.EmitInstrs cgbuf (pop 0) (Push [ ilArrayType ]) [ mkLdcInt32 0; I_newarr(ILArrayShape.SingleDimensional, ilElementType) ] else let vtspec = cgbuf.mgbuf.GenerateRawDataValueType(eenv.cloc, bytes.Length) - //let fi = eenv.cloc.Range.FileIndex let unique = g.CompilerGlobalState.Value.IlxGenNiceNameGenerator.IncrementOnly("@field", eenv.cloc.Range) From 45ffedcad1f04e46bf8b0db94b7a260e798a9cde Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 27 Oct 2025 21:01:25 +0100 Subject: [PATCH 16/17] remove misguided workaround --- src/Compiler/Checking/CheckDeclarations.fs | 7 +++++-- src/Compiler/CodeGen/IlxGen.fs | 1 + src/Compiler/Driver/CompilerImports.fs | 1 - src/Compiler/Service/IncrementalBuild.fs | 1 - src/Compiler/SyntaxTree/UnicodeLexing.fs | 2 +- src/Compiler/SyntaxTree/UnicodeLexing.fsi | 2 +- src/Compiler/TypedTree/TcGlobals.fs | 3 --- src/Compiler/TypedTree/TcGlobals.fsi | 3 --- 8 files changed, 8 insertions(+), 12 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 5095cd645e4..f701c70758a 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4218,13 +4218,16 @@ module TcDeclarations = | Result res -> // Update resolved type parameters with the names from the source. let _, tcref, _ = res - - if (not g.deterministic) && tcref.TyparsNoRange.Length = synTypars.Length then + + 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 + // TODO: mutating typar here can lead to a race during parallel type checking. + // Some type extensions can end up with a wrong type argument name. + // This will break deterministic builds. typar.SetIdent(untypedIdent) ) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index b936bd0e9b9..b61add1f3af 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -2766,6 +2766,7 @@ let GenConstArray cenv (cgbuf: CodeGenBuffer) eenv ilElementType (data: 'a[]) (w CG.EmitInstrs cgbuf (pop 0) (Push [ ilArrayType ]) [ mkLdcInt32 0; I_newarr(ILArrayShape.SingleDimensional, ilElementType) ] else let vtspec = cgbuf.mgbuf.GenerateRawDataValueType(eenv.cloc, bytes.Length) + let unique = g.CompilerGlobalState.Value.IlxGenNiceNameGenerator.IncrementOnly("@field", eenv.cloc.Range) diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index 54a037acd13..3fc933540a7 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2606,7 +2606,6 @@ and [] TcImports tcConfig.pathMap, tcConfig.langVersion, tcConfig.realsig, - tcConfig.deterministic, tcConfig.compilationMode ) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 6844adccbdb..6db19653f9a 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -573,7 +573,6 @@ type FrameworkImportsCache(size) = tcGlobals.pathMap, tcConfig.langVersion, tcConfig.realsig, - tcConfig.deterministic, tcConfig.compilationMode ) diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fs b/src/Compiler/SyntaxTree/UnicodeLexing.fs index 4ea41cbcf84..fd342293211 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fs +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fs @@ -8,7 +8,7 @@ open Internal.Utilities.Text.Lexing type Lexbuf = LexBuffer -type LexBuffer<'char> with +type LexBuffer<'Char> with member lexbuf.GetLocalData<'T when 'T: not null>(key: string, initializer) = match lexbuf.BufferLocalStore.TryGetValue key with diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fsi b/src/Compiler/SyntaxTree/UnicodeLexing.fsi index ee722ee08c3..1ceae431ed3 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fsi +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fsi @@ -9,7 +9,7 @@ open Internal.Utilities.Text.Lexing type Lexbuf = LexBuffer -type LexBuffer<'char> with +type LexBuffer<'Char> with member GetLocalData<'T when 'T: not null> : key: string * initializer: (unit -> 'T) -> 'T member TryGetLocalData<'T when 'T: not null> : key: string -> 'T option diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 06814e81f46..9999b801606 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -198,7 +198,6 @@ type TcGlobals( pathMap: PathMap, langVersion: LanguageVersion, realsig: bool, - deterministic: bool, compilationMode: CompilationMode) = let v_langFeatureNullness = langVersion.SupportsFeature LanguageFeature.NullnessChecking @@ -1848,8 +1847,6 @@ type TcGlobals( /// Are we assuming all code gen is for F# interactive, with no static linking member _.isInteractive=isInteractive - member val deterministic = deterministic - member val compilationMode = compilationMode /// Indicates if we are generating witness arguments for SRTP constraints. Only done if the FSharp.Core diff --git a/src/Compiler/TypedTree/TcGlobals.fsi b/src/Compiler/TypedTree/TcGlobals.fsi index d443b278a04..f4b866d8fbc 100644 --- a/src/Compiler/TypedTree/TcGlobals.fsi +++ b/src/Compiler/TypedTree/TcGlobals.fsi @@ -157,7 +157,6 @@ type internal TcGlobals = pathMap: Internal.Utilities.PathMap * langVersion: FSharp.Compiler.Features.LanguageVersion * realsig: bool * - deterministic: bool * compilationMode: CompilationMode -> TcGlobals @@ -827,8 +826,6 @@ type internal TcGlobals = /// Are we assuming all code gen is for F# interactive, with no static linking member isInteractive: bool - member deterministic: bool - member compilationMode: CompilationMode member isnull_info: IntrinsicValRef From 15fbf8fab5f32d7db6b8b366c1e520345bc580b2 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Wed, 29 Oct 2025 12:31:42 +0100 Subject: [PATCH 17/17] disable cosmetic typar overwrite in type extensions it needs to be made compatible with parallel checking --- src/Compiler/Checking/CheckDeclarations.fs | 24 ++++++++++--------- src/Compiler/SyntaxTree/UnicodeLexing.fs | 2 +- src/Compiler/SyntaxTree/UnicodeLexing.fsi | 2 +- .../Signatures/TypeTests.fs | 9 ++++--- 4 files changed, 21 insertions(+), 16 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index f701c70758a..3a5751d0905 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4218,18 +4218,20 @@ module TcDeclarations = | Result res -> // Update resolved type parameters with the names from the source. let _, tcref, _ = res + + // Disabled to allow deterministic parallel type checking. See https://github.com/dotnet/fsharp/issues/19033 + // TODO: mutating typar here can lead to a race during parallel type checking. + // Some type extensions can end up with a wrong type argument name. + // This will break deterministic builds. - 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 - // TODO: mutating typar here can lead to a race during parallel type checking. - // Some type extensions can end up with a wrong type argument name. - // This will break deterministic builds. - typar.SetIdent(untypedIdent) - ) + //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) + // ) tcref diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fs b/src/Compiler/SyntaxTree/UnicodeLexing.fs index fd342293211..4ea41cbcf84 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fs +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fs @@ -8,7 +8,7 @@ open Internal.Utilities.Text.Lexing type Lexbuf = LexBuffer -type LexBuffer<'Char> with +type LexBuffer<'char> with member lexbuf.GetLocalData<'T when 'T: not null>(key: string, initializer) = match lexbuf.BufferLocalStore.TryGetValue key with diff --git a/src/Compiler/SyntaxTree/UnicodeLexing.fsi b/src/Compiler/SyntaxTree/UnicodeLexing.fsi index 1ceae431ed3..ee722ee08c3 100644 --- a/src/Compiler/SyntaxTree/UnicodeLexing.fsi +++ b/src/Compiler/SyntaxTree/UnicodeLexing.fsi @@ -9,7 +9,7 @@ open Internal.Utilities.Text.Lexing type Lexbuf = LexBuffer -type LexBuffer<'Char> with +type LexBuffer<'char> with member GetLocalData<'T when 'T: not null> : key: string * initializer: (unit -> 'T) -> 'T member TryGetLocalData<'T when 'T: not null> : key: string -> 'T option diff --git a/tests/FSharp.Compiler.ComponentTests/Signatures/TypeTests.fs b/tests/FSharp.Compiler.ComponentTests/Signatures/TypeTests.fs index d025052b6fb..e209a5b78e6 100644 --- a/tests/FSharp.Compiler.ComponentTests/Signatures/TypeTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Signatures/TypeTests.fs @@ -76,7 +76,8 @@ namespace Foo.Types val EndColumn: int""" -[] +// See https://github.com/dotnet/fsharp/issues/19033 +[] let ``Type extension uses type parameters names from source`` () = FSharp """ module Extensions @@ -93,7 +94,8 @@ type List<'E> with member X: 'E""" -[] +// See https://github.com/dotnet/fsharp/issues/19033 +[] let ``Type extension with constraints uses type parameters names from source`` () = FSharp """ module Extensions @@ -110,7 +112,8 @@ type Map<'K,'V when 'K: comparison> with member X: t: 'T -> k: 'K -> 'K option * ({| n: 'K array |} * int) when 'K: comparison""" -[] +// See https://github.com/dotnet/fsharp/issues/19033 +[] let ``Type extension with lowercase type parameters names from source`` () = FSharp """ module Extensions