diff --git a/FSharp.sln b/FSharp.sln index 20c74ace2f..202812347f 100644 --- a/FSharp.sln +++ b/FSharp.sln @@ -109,6 +109,8 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ParallelTypeCheckingTests", "tests\ParallelTypeCheckingTests\ParallelTypeCheckingTests.fsproj", "{59C31D40-97E0-4A69-ABD9-D316BD798ED8}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ArgsGenerator", "tests\ArgsGenerator\ArgsGenerator.fsproj", "{90F850DD-52AD-40BC-A497-DE0382C1EE72}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -443,6 +445,18 @@ Global {59C31D40-97E0-4A69-ABD9-D316BD798ED8}.Release|Any CPU.Build.0 = Release|Any CPU {59C31D40-97E0-4A69-ABD9-D316BD798ED8}.Release|x86.ActiveCfg = Release|Any CPU {59C31D40-97E0-4A69-ABD9-D316BD798ED8}.Release|x86.Build.0 = Release|Any CPU + {90F850DD-52AD-40BC-A497-DE0382C1EE72}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {90F850DD-52AD-40BC-A497-DE0382C1EE72}.Debug|Any CPU.Build.0 = Debug|Any CPU + {90F850DD-52AD-40BC-A497-DE0382C1EE72}.Debug|x86.ActiveCfg = Debug|Any CPU + {90F850DD-52AD-40BC-A497-DE0382C1EE72}.Debug|x86.Build.0 = Debug|Any CPU + {90F850DD-52AD-40BC-A497-DE0382C1EE72}.Proto|Any CPU.ActiveCfg = Debug|Any CPU + {90F850DD-52AD-40BC-A497-DE0382C1EE72}.Proto|Any CPU.Build.0 = Debug|Any CPU + {90F850DD-52AD-40BC-A497-DE0382C1EE72}.Proto|x86.ActiveCfg = Debug|Any CPU + {90F850DD-52AD-40BC-A497-DE0382C1EE72}.Proto|x86.Build.0 = Debug|Any CPU + {90F850DD-52AD-40BC-A497-DE0382C1EE72}.Release|Any CPU.ActiveCfg = Release|Any CPU + {90F850DD-52AD-40BC-A497-DE0382C1EE72}.Release|Any CPU.Build.0 = Release|Any CPU + {90F850DD-52AD-40BC-A497-DE0382C1EE72}.Release|x86.ActiveCfg = Release|Any CPU + {90F850DD-52AD-40BC-A497-DE0382C1EE72}.Release|x86.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE @@ -476,6 +490,7 @@ Global {BEC6E796-7E53-4888-AAFC-B8FD55C425DF} = {CE70D631-C5DC-417E-9CDA-B16097BEF1AC} {9C7523BA-7AB2-4604-A5FD-653E82C2BAD1} = {CE70D631-C5DC-417E-9CDA-B16097BEF1AC} {59C31D40-97E0-4A69-ABD9-D316BD798ED8} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} + {90F850DD-52AD-40BC-A497-DE0382C1EE72} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449} EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution SolutionGuid = {BD5177C7-1380-40E7-94D2-7768E1A8B1B8} diff --git a/NuGet.config b/NuGet.config index 5b0a8ef0a0..ef9293a43e 100644 --- a/NuGet.config +++ b/NuGet.config @@ -15,6 +15,7 @@ + diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 4d7c15cd36..dd6daec789 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1738,8 +1738,6 @@ let CheckMultipleInputsInParallel let mutable CheckMultipleInputsUsingGraphMode: CheckArgs -> (PartialResult list * TcState) = fun _ -> failwith $"Graph-based type-checking function not set - set CheckMultipleInputsUsingGraphMode before using this mode" -let mutable typeCheckingMode: TypeCheckingMode = TypeCheckingMode.Sequential - let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) = // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions let results, tcState = diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index 708111d89f..0444db365c 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -202,8 +202,6 @@ val CheckMultipleInputsFinish: /// Finish the checking of a closed set of inputs val CheckClosedInputSetFinish: CheckedImplFile list * TcState -> TcState * CheckedImplFile list * ModuleOrNamespace -val mutable typeCheckingMode: TypeCheckingMode - /// Check a closed set of inputs val CheckClosedInputSet: ctok: CompilationThreadToken * diff --git a/tests/ArgsGenerator/ArgsGenerator.fsproj b/tests/ArgsGenerator/ArgsGenerator.fsproj new file mode 100644 index 0000000000..82ac2ed92c --- /dev/null +++ b/tests/ArgsGenerator/ArgsGenerator.fsproj @@ -0,0 +1,23 @@ + + + + net7.0 + true + exe + true + + + + + + + + + + + + + + + + diff --git a/tests/ArgsGenerator/Program.fs b/tests/ArgsGenerator/Program.fs new file mode 100644 index 0000000000..7f7140e61e --- /dev/null +++ b/tests/ArgsGenerator/Program.fs @@ -0,0 +1,40 @@ +module ArgsGenerator + +open System.IO +open FSharp.Compiler.CodeAnalysis +open Ionide.ProjInfo + +let optionsToArgs (opts: FSharpProjectOptions) : string[] = + Array.append opts.OtherOptions opts.SourceFiles + +let loadProjectArgs (projectFile: string) = + let dir = Path.GetDirectoryName projectFile + let _ = Init.init (DirectoryInfo dir) None + + let props = + [ + "TargetFramework", "net7.0" + "Configuration", "Release" + ] + let res = + ProjectLoader.getProjectInfo projectFile props (BinaryLogGeneration.Within(DirectoryInfo("c:/projekty/fsharp/cracking_logs"))) + + match res [] with + | Result.Ok _res -> + let fcs = FCS.mapToFSharpProjectOptions _res [] + let args = optionsToArgs fcs + args + | Result.Error err -> failwith $"Failed to crack project: {err}" + +/// Given a project file to analyse, generates fsc commandline arguments for compiling it, then saves them to a file. +[] +let main argv = + match argv with + | [| projectFile; outputFile |] -> + printfn $"Loading project args for project file: {projectFile}" + let args = loadProjectArgs projectFile + printfn $"Loaded {args.Length} args. Saving them to {outputFile}" + File.WriteAllLines(outputFile, args) + 0 + | _ -> + failwith "Invalid args. Usage: 'ArgsGenerator.exe %project_file% %output_file%'" diff --git a/tests/ParallelTypeCheckingTests/ParallelTypeCheckingTests.fsproj b/tests/ParallelTypeCheckingTests/ParallelTypeCheckingTests.fsproj index cb6a1c7ade..7c53f70ead 100644 --- a/tests/ParallelTypeCheckingTests/ParallelTypeCheckingTests.fsproj +++ b/tests/ParallelTypeCheckingTests/ParallelTypeCheckingTests.fsproj @@ -72,8 +72,4 @@ - - - - diff --git a/tests/ParallelTypeCheckingTests/Program.fs b/tests/ParallelTypeCheckingTests/Program.fs index 9e0c9dd961..2b2d68257a 100644 --- a/tests/ParallelTypeCheckingTests/Program.fs +++ b/tests/ParallelTypeCheckingTests/Program.fs @@ -1,35 +1,28 @@ module internal ParallelTypeCheckingTests.Program -#nowarn "1182" - -open FSharp.Compiler.CompilerConfig open ParallelTypeCheckingTests.TestUtils -let _parse (argv: string[]) : Args = - let parseMode (mode: string) = - match mode.ToLower() with +let parseArgs (argv: string[]) : Args = + let parseMode (method: string) = + match method.ToLower() with | "sequential" -> Method.Sequential | "parallelfs" -> Method.ParallelCheckingOfBackedImplFiles | "graph" -> Method.Graph - | _ -> failwith $"Unrecognised mode: {mode}" + | _ -> failwith $"Unrecognised method: {method}" - let path, mode, workingDir = + let method, path = match argv with - | [| path |] -> path, Method.Sequential, None - | [| path; method |] -> path, parseMode method, None - | [| path; method; workingDir |] -> path, parseMode method, Some workingDir - | _ -> failwith "Invalid args - use 'args_path [method [fs-parallel]]'" + | [| path |] -> Method.Graph, path + | [| method; path |] -> parseMode method, path + | _ -> failwith "Invalid args. Usage: '%method% %project_file%'" { - Path = path - LineLimit = None - Method = mode - WorkingDir = workingDir + Method = method + ProjectFile = path } [] -let main _argv = - let args = _parse _argv - let args = { args with LineLimit = None } +let main argv = + let args = parseArgs argv TestCompilationFromCmdlineArgs.TestCompilerFromArgs args 0 diff --git a/tests/ParallelTypeCheckingTests/Tests/TestCompilationFromCmdlineArgs.fs b/tests/ParallelTypeCheckingTests/Tests/TestCompilationFromCmdlineArgs.fs index ba41fdb324..da1301567b 100644 --- a/tests/ParallelTypeCheckingTests/Tests/TestCompilationFromCmdlineArgs.fs +++ b/tests/ParallelTypeCheckingTests/Tests/TestCompilationFromCmdlineArgs.fs @@ -10,55 +10,22 @@ open ParallelTypeCheckingTests.TestUtils type Codebase = { - WorkDir: string - Path: string - Limit: int option + ProjectFile : string } let codebases = [| { - WorkDir = $@"{__SOURCE_DIRECTORY__}\.fcs_test\src\compiler" - Path = $@"{__SOURCE_DIRECTORY__}\FCS.args.txt" - Limit = None + ProjectFile = $@"{__SOURCE_DIRECTORY__}\.fcs_test\src\compiler\FSharp.Compiler.Service.fsproj" } { - WorkDir = $@"{__SOURCE_DIRECTORY__}\.fcs_test\tests\FSharp.Compiler.ComponentTests" - Path = $@"{__SOURCE_DIRECTORY__}\ComponentTests.args.txt" - Limit = None + ProjectFile = $@"{__SOURCE_DIRECTORY__}\.fcs_test\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" } |] -let internal setupParsed config = - let { - Path = path - LineLimit = lineLimit - Method = method - WorkingDir = workingDir - } = - config - - let args = - System.IO.File.ReadAllLines(path |> replacePaths) - |> fun lines -> - match lineLimit with - | Some limit -> Array.take (Math.Min(limit, lines.Length)) lines - | None -> lines - |> Array.map replacePaths - - setupCompilationMethod method - - printfn $"Method: {method}" - let args = - match method with - | Method.Sequential -> args - | Method.ParallelCheckingOfBackedImplFiles -> - Array.append args [|"--test:ParallelCheckingWithSignatureFilesOn"|] - | Method.Graph -> - Array.append args [|"--test:GraphBasedChecking"|] - - printfn $"WorkingDir = {workingDir}" - workingDir |> Option.iter (fun dir -> Environment.CurrentDirectory <- dir) +let internal setupParsed {Method = method; ProjectFile = path} = + let args = getProjectArgs path + let args = Array.append args (TestCompilation.methodOptions method |> List.toArray) args let internal TestCompilerFromArgs (config: Args) : unit = @@ -75,36 +42,33 @@ let internal TestCompilerFromArgs (config: Args) : unit = } try + printfn $"Type-checking method used: {config.Method}" let args = setupParsed config let exit: int = CommandLineMain.mainAux (args, true, Some exiter) Assert.That(exit, Is.Zero) finally Environment.CurrentDirectory <- oldWorkDir -let internal codebaseToConfig code method = +let internal codebaseToConfig (code : Codebase) method = { - Path = code.Path - LineLimit = code.Limit + ProjectFile = code.ProjectFile Method = method - WorkingDir = Some code.WorkDir } -[] +[] [] let ``1. Test sequential type-checking`` (code: Codebase) = let config = codebaseToConfig code Method.Sequential TestCompilerFromArgs config -/// Before running this test, you must prepare the codebase by running the script 'FCS.prepare.ps1' -[] +[] [] let ``2. Test parallelfs type-checking`` (code: Codebase) = let config = codebaseToConfig code Method.ParallelCheckingOfBackedImplFiles TestCompilerFromArgs config -/// Before running this test, you must prepare the codebase by running the script 'FCS.prepare.ps1' -[] +[] let ``3. Test graph-based type-checking`` (code: Codebase) = let config = codebaseToConfig code Method.Graph + printfn $"Args file generated: {config.ProjectFile}" TestCompilerFromArgs config - diff --git a/tests/ParallelTypeCheckingTests/Tests/TestDependencyResolution.fs b/tests/ParallelTypeCheckingTests/Tests/TestDependencyResolution.fs index 17980c16d4..c2ad05bf06 100644 --- a/tests/ParallelTypeCheckingTests/Tests/TestDependencyResolution.fs +++ b/tests/ParallelTypeCheckingTests/Tests/TestDependencyResolution.fs @@ -4,7 +4,6 @@ open FSharp.Compiler.Service.Tests.Common open System.IO -open Buildalyzer open ParallelTypeCheckingTests open ParallelTypeCheckingTests.Types open ParallelTypeCheckingTests.Utils @@ -337,53 +336,31 @@ let analyseResult (result: DepsResult) = v |> Array.map (fun d -> result.Graph[d].Length) |> Array.max) printfn $"TotalDeps: {totalDeps}, topFirstDeps: {topFirstDeps}" -// -// open GiGraph.Dot.Extensions -// open GiGraph.Dot.Output.Options -// let makeDotFile (path : string) (graph : Graph) : unit = -// let g = DotGraph(directed=true) -// g.Layout.Direction <- DotLayoutDirection.LeftToRight -// let name (f : File) = $"{f.QualifiedName}.{Path.GetExtension(f.Name)}" -// graph -// |> Graph.collectEdges -// |> Array.iter (fun (a, b) -> g.Edges.Add(name a, name b) |> ignore) -// let _options = DotFormattingOptions() -// printfn $"{g.Build()}" -// g.SaveToFile(path) [] let ``Analyse hardcoded files`` () = let deps = DependencyResolution.detectFileDependencies sampleFiles printfn "Detected file dependencies:" deps.Graph |> Graph.print - // makeDotFile "graph.dot" deps.Graph let private parseProjectAndGetSourceFiles (projectFile: string) = - //let cacheDir = "." - //let getName projectFile = Path.Combine(Path.GetFileName(projectFile), ".fsharp" - let m = AnalyzerManager() - let analyzer = m.GetProject(projectFile) - let results = analyzer.Build() - // TODO Generalise for multiple TFMs - let res = results.Results |> Seq.head - let files = res.SourceFiles - log "built project using Buildalyzer" - files + projectFile + |> TestUtils.getProjectArgs + |> TestUtils.extractSourceFilesFromArgs [] [] -[] let ``Analyse whole projects and print statistics`` (projectFile: string) = log $"Start finding file dependency graph for {projectFile}" let files = parseProjectAndGetSourceFiles projectFile + log $"{files.Length} source files loaded using ProjInfo" let files = files |> Array.Parallel.mapi (fun i f -> let code = System.IO.File.ReadAllText(f) let ast = parseSourceCode (f, code) - { Idx = FileIdx.make i //Code = code @@ -420,5 +397,3 @@ let ``Analyse whole projects and print statistics`` (projectFile: string) = v |> Array.map (fun d -> graph.Graph[d].Length) |> Array.max) printfn $"TotalDeps: {totalDeps}, topFirstDeps: {topFirstDeps}, diff: {totalDeps - topFirstDeps}" - - // makeDotFile "FCS.deps.dot" graph.Graph diff --git a/tests/ParallelTypeCheckingTests/Tests/Utils.fs b/tests/ParallelTypeCheckingTests/Tests/Utils.fs index 999d5b14be..c60cf9f584 100644 --- a/tests/ParallelTypeCheckingTests/Tests/Utils.fs +++ b/tests/ParallelTypeCheckingTests/Tests/Utils.fs @@ -1,15 +1,16 @@ module ParallelTypeCheckingTests.TestUtils open System +open System.IO open FSharp.Compiler open FSharp.Compiler.CompilerConfig -open ParallelTypeCheckingTests open Xunit open FSharp.Test open FSharp.Test.Compiler open OpenTelemetry open OpenTelemetry.Resources open OpenTelemetry.Trace +open System.Diagnostics let packages = // Here we assume that the NuGet packages are located in a certain user folder, @@ -45,14 +46,13 @@ let setupOtel () = c.MaxPayloadSizeInBytes <- Nullable(1000000000)) .Build() -type internal Args = + +type Args = { - Path: string - LineLimit: int option - Method: Method - WorkingDir: string option + Method : Method + ProjectFile : string } - + let makeCompilationUnit (files: (string * string) list) : CompilationUnit = let files = files |> List.map (fun (name, code) -> SourceCodeFileKind.Create(name, code)) @@ -69,9 +69,57 @@ let internal mapMethod (method: Method) = | Method.ParallelCheckingOfBackedImplFiles -> TypeCheckingMode.ParallelCheckingOfBackedImplFiles | Method.Graph -> TypeCheckingMode.Graph -/// Includes mutation of static config. -/// A very hacky way to setup the given type-checking method - mutates static state and returns new args -/// TODO Make the method configurable via proper config passed top-down -let setupCompilationMethod (method: Method) = - let mode = mapMethod method - ParseAndCheckInputs.typeCheckingMode <- mode +let runProcess + (name : string) + (args : string) + workingDir + (envVariables : (string * string) list) + = + let info = ProcessStartInfo () + info.WindowStyle <- ProcessWindowStyle.Hidden + info.Arguments <- args + info.FileName <- name + info.UseShellExecute <- false + info.WorkingDirectory <- workingDir + info.CreateNoWindow <- true + + envVariables |> List.iter (fun (k, v) -> info.EnvironmentVariables[ k ] <- v) + + printfn $"Running '{name} {args}' in '{workingDir}'" + let p = new Process (StartInfo = info) + p.EnableRaisingEvents <- true + p.Start () |> ignore + p.WaitForExit () + + if p.ExitCode <> 0 then + failwith $"Running process '{name} {args}' failed." + +let getProjectArgs (projectFile : string) : string[] = + // TODO Make ArgsGenerator a dotnet tool + let argsGeneratorProjectPath = $"{__SOURCE_DIRECTORY__}/../../ArgsGenerator/ArgsGenerator.fsproj" + let workingDir = "." + let name = "dotnet.exe" // TODO Handle non-Windows OS + let argsFile = Path.GetTempFileName() + let envVariables = [] + + // We run the ArgsGenerator project using 'dotnet run', and specify two arguments: project file to analyse, output file. + let args = + [| + "run" + "--project" + argsGeneratorProjectPath + "--" + $"\"{projectFile}\"" + argsFile + |] + |> fun args -> String.Join(" ", args) + + runProcess name args workingDir envVariables + + let output = File.ReadAllLines argsFile + output + +/// Given FSC arguments, extract those that represent source files +let extractSourceFilesFromArgs (args: string[]): string[] = + args + |> Array.filter (fun arg -> arg.StartsWith("-") |> not) \ No newline at end of file