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 219ee92ba9f..f9507bef000 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.0.md @@ -12,6 +12,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 diff --git a/src/Compiler/AbstractIL/ilwritepdb.fs b/src/Compiler/AbstractIL/ilwritepdb.fs index bc3dbf18adc..f78829e5cba 100644 --- a/src/Compiler/AbstractIL/ilwritepdb.fs +++ b/src/Compiler/AbstractIL/ilwritepdb.fs @@ -343,9 +343,12 @@ 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 +421,16 @@ type PortablePdbGenerator Some(builder.ToImmutableArray()) + // Build Document table in deterministic order let documentIndex = - let mutable index = Dictionary(docs.Length) + let mutable index = Dictionary(docsSorted.Length) - let docLength = docs.Length + if String.IsNullOrEmpty sourceLink then 1 else 0 + 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 +480,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 +568,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 +654,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 +668,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) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 86b780b251c..76097c53dd5 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4222,14 +4222,20 @@ module TcDeclarations = | 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) - ) + + // 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 + // typar.SetIdent(untypedIdent) + // ) tcref diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 7c917fbfa9a..b61add1f3af 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 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/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) diff --git a/src/Compiler/Driver/OptimizeInputs.fs b/src/Compiler/Driver/OptimizeInputs.fs index c79af5b33bc..78bca4bf979 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 @@ -578,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/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 518b99bdf84..3fb4ba6922c 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1881,11 +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 - && not tcConfig.deterministic) - -> + | TypeCheckingMode.Graph when (not tcConfig.isInteractive && not tcConfig.compilingFSharpCore) -> CheckMultipleInputsUsingGraphMode( ctok, checkForErrors, diff --git a/src/Compiler/TypedTree/CompilerGlobalState.fs b/src/Compiler/TypedTree/CompilerGlobalState.fs index 12dda2b08d8..4a73e26e73c 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fs +++ b/src/Compiler/TypedTree/CompilerGlobalState.fs @@ -18,19 +18,24 @@ 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) + + let increment basicName (m: range) = + let key = struct (basicName, m.FileIndex) + let countCell = basicNameCounts.GetOrAdd(key, basicNameCountsAddDelegate) + Interlocked.Increment(countCell) member _.FreshCompilerGeneratedNameOfBasicName (basicName, m: range) = - let countCell = basicNameCounts.GetOrAdd(basicName, basicNameCountsAddDelegate) - let count = Interlocked.Increment(countCell) - - CompilerGeneratedNameSuffix basicName (string m.StartLine + (match (count-1) with 0 -> "" | n -> "-" + string n)) + 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 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 [ 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 diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs index 4142b10565f..634e9fef7ea 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,14 +36,24 @@ 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 + +let compileAValidScenario (scenario: Scenario) (method: Method) = + compileScenario scenario method |> shouldSucceed |> ignore -let scenarios = scenarios |> List.map (fun c -> [| box c |]) +let scenarios = compilingScenarios |> List.map (fun c -> [| box c |]) [] [] @@ -54,3 +64,17 @@ let ``Compile a valid scenario using graph-based type-checking`` (scenario) = [] let ``Compile a valid scenario using sequential type-checking`` (scenario) = compileAValidScenario scenario Method.Sequential + +[] +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 5126282048c..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,4 +1085,106 @@ module Y = global.Z.N """ (set [| 0 |]) ] - ] \ No newline at end of file + 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 |]) + ] + ] + + +// 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