From 0ed044292d145b5f33c8f3eefb891c8484e931e6 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 21 Oct 2024 14:55:31 +0200 Subject: [PATCH 1/8] rebase --- eng/Build.ps1 | 119 ++++++-- eng/Versions.props | 2 +- eng/build.sh | 3 +- .../Driver/GraphChecking/GraphProcessing.fs | 1 + src/Compiler/Driver/fsc.fs | 24 +- src/Compiler/Interactive/fsi.fs | 22 +- src/Compiler/Service/service.fs | 8 - src/Compiler/Utilities/illib.fs | 2 +- src/FSharp.Core/mailbox.fs | 7 +- src/fsi/fsimain.fs | 10 - .../BasicProvider.Tests.fsproj | 2 +- .../ComboProvider.Tests.fsproj | 3 +- .../FSharp.Build.UnitTests.fsproj | 11 +- .../FSharp.Build.UnitTests/xunit.runner.json | 5 + .../CompilerOptions/fsc/misc/utf8output.fs | 46 +++ .../CompilerOptions/fsc/times/times.fs | 2 + .../AttributeUsage/AssemblyVersion04.fs | 2 +- .../Events/Basic/Basic.fs | 1 + .../EmittedIL/TryCatch/TryCatch.fs | 4 +- .../FSharp.Compiler.ComponentTests.fsproj | 4 + .../FSharpChecker/TransparentCompiler.fs | 123 ++++---- ...rnTypeDirectedPartialActivePatternTests.fs | 2 + .../SequenceExpressionTests.fs | 2 + .../Miscellaneous/FsharpSuiteMigrated.fs | 10 +- .../Miscellaneous/MigratedCoreTests.fs | 40 +-- .../TypeChecks/Graph/Utils.fs | 4 +- .../TypeChecks/TyparNameTests.fs | 2 +- .../xunit.runner.json | 8 +- .../DependencyManagerInteractiveTests.fs | 5 +- ...ompiler.Private.Scripting.UnitTests.fsproj | 5 +- .../FSharpScriptTests.fs | 8 +- .../xunit.runner.json | 8 +- .../AssemblyContentProviderTests.fs | 2 +- tests/FSharp.Compiler.Service.Tests/Common.fs | 4 +- .../FSharp.Compiler.Service.Tests.fsproj | 3 + .../FSharpExprPatternsTests.fs | 2 +- .../FileSystemTests.fs | 2 + .../FsiHelpTests.fs | 1 - .../FSharp.Compiler.Service.Tests/FsiTests.fs | 8 +- .../ProjectAnalysisTests.fs | 4 +- .../TooltipTests.fs | 4 +- .../xunit.runner.json | 6 +- .../FSharp.Core.UnitTests.fsproj | 5 +- .../FSharp.Core/ComparersRegression.fs | 1 + .../Microsoft.FSharp.Control/AsyncModule.fs | 53 ++-- .../Microsoft.FSharp.Control/AsyncType.fs | 7 +- .../Microsoft.FSharp.Control/Cancellation.fs | 2 +- .../MailboxProcessorType.fs | 1 + .../Microsoft.FSharp.Control/Tasks.fs | 3 +- .../Microsoft.FSharp.Control/TasksDynamic.fs | 5 +- tests/FSharp.Core.UnitTests/xunit.runner.json | 8 +- tests/FSharp.Test.Utilities/Compiler.fs | 199 +++++++------ tests/FSharp.Test.Utilities/CompilerAssert.fs | 279 ++++++++---------- .../DirectoryAttribute.fs | 25 +- .../FSharp.Test.Utilities.fsproj | 11 +- tests/FSharp.Test.Utilities/ILChecker.fs | 3 +- tests/FSharp.Test.Utilities/Peverifier.fs | 3 +- .../ProjectGeneration.fs | 113 ++++--- tests/FSharp.Test.Utilities/ScriptHelpers.fs | 24 +- .../FSharp.Test.Utilities/ScriptingShims.fsx | 10 +- tests/FSharp.Test.Utilities/TestFramework.fs | 36 +-- tests/FSharp.Test.Utilities/Utilities.fs | 35 +-- tests/FSharp.Test.Utilities/XunitHelpers.fs | 222 ++++++++++++++ tests/FSharp.Test.Utilities/XunitSetup.fs | 12 + .../CodeGen/EmittedIL/DeterministicTests.fs | 2 +- .../Compiler/Service/MultiProjectTests.fs | 6 +- tests/fsharp/FSharpSuite.Tests.fsproj | 6 +- tests/fsharp/TypeProviderTests.fs | 2 +- tests/fsharp/XunitHelpers.fs | 3 - tests/fsharp/tests.fs | 2 +- tests/fsharp/xunit.runner.json | 4 +- tests/scripts/scriptlib.fsx | 23 +- .../BraceMatchingServiceTests.fs | 3 +- .../EditorFormattingServiceTests.fs | 12 +- .../IndentationServiceTests.fs | 3 +- .../SignatureHelpProviderTests.fs | 3 +- 76 files changed, 976 insertions(+), 681 deletions(-) create mode 100644 tests/FSharp.Build.UnitTests/xunit.runner.json create mode 100644 tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/utf8output.fs create mode 100644 tests/FSharp.Test.Utilities/XunitHelpers.fs create mode 100644 tests/FSharp.Test.Utilities/XunitSetup.fs diff --git a/eng/Build.ps1 b/eng/Build.ps1 index 483b60b10df..d282b47b9ef 100644 --- a/eng/Build.ps1 +++ b/eng/Build.ps1 @@ -362,36 +362,81 @@ function VerifyAssemblyVersionsAndSymbols() { } } -function TestUsingMSBuild([string] $testProject, [string] $targetFramework, [string]$testadapterpath, [boolean] $asBackgroundJob = $false) { +function TestUsingMSBuild([string] $testProject, [string] $targetFramework, [string]$testadapterpath, [string] $backgroundJob = "", [string] $settings = "") { + $jobId = if ($backgroundJob) { "_$backgroundJob"} else {""} $dotnetPath = InitializeDotNetCli $dotnetExe = Join-Path $dotnetPath "dotnet.exe" $projectName = [System.IO.Path]::GetFileNameWithoutExtension($testProject) - $testLogPath = "$ArtifactsDir\TestResults\$configuration\${projectName}_$targetFramework.xml" - $testBinLogPath = "$LogDir\${projectName}_$targetFramework.binlog" - $args = "test $testProject -c $configuration -f $targetFramework -v n --test-adapter-path $testadapterpath --logger ""xunit;LogFilePath=$testLogPath"" /bl:$testBinLogPath" - $args += " --blame --results-directory $ArtifactsDir\TestResults\$configuration -p:vstestusemsbuildoutput=false" + $testLogPath = "$ArtifactsDir\TestResults\$configuration\${projectName}_$targetFramework$jobId.xml" + $testBinLogPath = "$LogDir\${projectName}_$targetFramework$jobId.binlog" + $arguments = "test $testProject -c $configuration -f $targetFramework -v n --test-adapter-path $testadapterpath --logger ""xunit;LogFilePath=$testLogPath"" /bl:$testBinLogPath" + $arguments += " --blame --blame-hang-timeout 5minutes --results-directory $ArtifactsDir\TestResults\$configuration -p:vstestusemsbuildoutput=true" if (-not $noVisualStudio -or $norestore) { - $args += " --no-restore" + $arguments += " --no-restore" } if (-not $noVisualStudio) { - $args += " --no-build" + $arguments += " --no-build" } - if ($asBackgroundJob) { - Write-Host("Starting on the background: $args") + $arguments += " $settings" + + if ($backgroundJob) { + Write-Host + Write-Host("Starting on the background: $arguments") Write-Host("------------------------------------") - $bgJob = Start-Job -ScriptBlock { - & $using:dotnetExe test $using:testProject -c $using:configuration -f $using:targetFramework -v n --test-adapter-path $using:testadapterpath --logger "xunit;LogFilePath=$using:testLogPath" /bl:$using:testBinLogPath --blame --results-directory $using:ArtifactsDir\TestResults\$using:configuration + Start-Job -ScriptBlock { + $argArray = $using:arguments -Split " " + & $using:dotnetExe $argArray if ($LASTEXITCODE -ne 0) { throw "Command failed to execute with exit code $($LASTEXITCODE): $using:dotnetExe $using:args" } } - return $bgJob - } else{ - Write-Host("$args") - Exec-Console $dotnetExe $args + } else { + Write-Host("$arguments") + Exec-Console $dotnetExe $arguments + } +} + +function TestSolutionUsingMSBuild([string] $testSolution, [string] $targetFramework, [string] $testadapterpath, [string] $backgroundJob = "", [string] $settings = "") { + $jobId = if ($backgroundJob) { "_$backgroundJob"} else {""} + $dotnetPath = InitializeDotNetCli + $dotnetExe = Join-Path $dotnetPath "dotnet.exe" + $solutionName = [System.IO.Path]::GetFileNameWithoutExtension($testSolution) + $testLogPath = "$ArtifactsDir\TestResults\$configuration\{assembly}.{framework}$jobId.xml" + $testBinLogPath = "$LogDir\${solutionName}_$targetFramework$jobId.binlog" + + $arguments = "test" + + $arguments += " $testSolution -c $configuration -f $targetFramework --test-adapter-path $testadapterpath -v n --logger ""xunit;LogFilePath=$testLogPath"" /bl:$testBinLogPath" + $arguments += " --blame-hang-timeout 5minutes --results-directory $ArtifactsDir\TestResults\$configuration /p:VsTestUseMSBuildOutput=true" + + if (-not $noVisualStudio -or $norestore) { + $arguments += " --no-restore" + } + + if (-not $noVisualStudio) { + $arguments += " --no-build" + } + + $arguments += " $settings" + + if ($backgroundJob) { + Write-Host + Write-Host("Starting on the background: $arguments") + Write-Host("------------------------------------") + Start-Job -ScriptBlock { + $argArray = $using:arguments -Split " " + $argArray += "--no-build" + & $using:dotnetExe $argArray + if ($LASTEXITCODE -ne 0) { + throw "Command failed to execute with exit code $($LASTEXITCODE): $using:dotnetExe $using:args" + } + } + } else { + Write-Host("$arguments") + Exec-Console $dotnetExe $arguments } } @@ -588,22 +633,40 @@ try { $script:BuildCategory = "Test" $script:BuildMessage = "Failure running tests" + function Receive($job) { + while($job.HasMoreData) { + Receive-Job $job | Write-Host + Start-Sleep -Seconds 1 + } + Receive-Job $job -Wait -ErrorAction Stop + } + if ($testCoreClr) { - $bgJob = TestUsingMSBuild -testProject "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" -asBackgroundJob $true + $cpuLimit = if ($ci) { "-m:2 -- xUnit.MaxParallelThreads=0.25x" } else { "" } + TestSolutionUsingMSBuild -testSolution "$RepoRoot\FSharp.sln" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -settings $cpuLimit + } - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Service.Tests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Private.Scripting.UnitTests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Build.UnitTests\FSharp.Build.UnitTests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Build.UnitTests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Core.UnitTests\FSharp.Core.UnitTests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Core.UnitTests\" + if ($testDesktop -and -not $ci) { + + # Split ComponentTests into processes using filter, because it is slow and underutilizes CPU locally. + $bgJob1 = TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -backgroundJob 1 -settings "--filter ExecutionNode=1" + $bgJob2 = TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -backgroundJob 2 -settings "--filter ExecutionNode=2" + $bgJob3 = TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -backgroundJob 3 -settings "--filter ExecutionNode=3" + $bgJob4 = TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -backgroundJob 4 -settings "--filter ExecutionNode=4" + + TestSolutionUsingMSBuild -testSolution "$RepoRoot\FSharp.sln" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -settings " --filter ""Project!=FSharpSuite.Tests&Project!=FSharp.Compiler.ComponentTests"" " + # FSharpSuite does most of it's work in external processes, saturating the CPU. It makes sense to run it separately. + TestUsingMSBuild -testProject "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" - # Collect output from background jobs - Wait-job $bgJob | out-null - Receive-Job $bgJob -ErrorAction Stop + # Collect output from background jobs + Receive -job $bgJob1 + Receive -job $bgJob2 + Receive -job $bgJob3 + Receive -job $bgJob4 } - if ($testDesktop) { - $bgJob = TestUsingMSBuild -testProject "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" -asBackgroundJob $true + if ($testDesktop -and $ci) { + $bgJob = TestUsingMSBuild -testProject "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" -backgroundJob 1 TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Service.Tests\" @@ -611,9 +674,7 @@ try { TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Build.UnitTests\FSharp.Build.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Build.UnitTests\" TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Core.UnitTests\FSharp.Core.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Core.UnitTests\" - # Collect output from background jobs - Wait-job $bgJob | out-null - Receive-Job $bgJob -ErrorAction Stop + Receive -job $bgJob } if ($testFSharpQA) { diff --git a/eng/Versions.props b/eng/Versions.props index 4252f548c66..3aa86815fa5 100644 --- a/eng/Versions.props +++ b/eng/Versions.props @@ -184,7 +184,7 @@ 3.1.0 5.0.0-preview.7.20364.11 5.0.0-preview.7.20364.11 - 17.4.0 + 17.11.1 13.0.3 1.0.0-beta2-dev3 2.18.48 diff --git a/eng/build.sh b/eng/build.sh index c4abb23f6f1..b190cea22ed 100755 --- a/eng/build.sh +++ b/eng/build.sh @@ -214,7 +214,8 @@ function Test() { projectname=$(basename -- "$testproject") projectname="${projectname%.*}" testlogpath="$artifacts_dir/TestResults/$configuration/${projectname}_$targetframework.xml" - args="test \"$testproject\" --no-restore --no-build -c $configuration -f $targetframework --test-adapter-path . --logger \"xunit;LogFilePath=$testlogpath\" --blame --results-directory $artifacts_dir/TestResults/$configuration -p:vstestusemsbuildoutput=false" + args="test \"$testproject\" --no-restore --no-build -c $configuration -f $targetframework --test-adapter-path . --logger \"xunit;LogFilePath=$testlogpath\" --blame-hang-timeout 5minutes --results-directory $artifacts_dir/TestResults/$configuration -p:vstestusemsbuildoutput=false" + args+=" -- xUnit.MaxParallelThreads=4" "$DOTNET_INSTALL_DIR/dotnet" $args || exit $? } diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs index 218c9d6b2ac..33dd1c42c46 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs +++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs @@ -252,6 +252,7 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison> let rec queueNode node = Async.Start( async { + use! _catch = Async.OnCancel(completionSignal.TrySetCanceled >> ignore) let! res = processNode node |> Async.Catch match res with diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index ac4ee179538..a74f35f21b5 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -273,9 +273,6 @@ let SetProcessThreadLocals tcConfigB = | Some s -> Thread.CurrentThread.CurrentUICulture <- CultureInfo(s) | None -> () - if tcConfigB.utf8output then - Console.OutputEncoding <- Encoding.UTF8 - let ProcessCommandLineFlags (tcConfigB: TcConfigBuilder, lcidFromCodePage, argv) = let mutable inputFilesRef = [] @@ -550,6 +547,17 @@ let main1 | Some parallelReferenceResolution -> tcConfigB.parallelReferenceResolution <- parallelReferenceResolution | None -> () + if tcConfigB.utf8output && Console.OutputEncoding <> Encoding.UTF8 then + let previousEncoding = Console.OutputEncoding + Console.OutputEncoding <- Encoding.UTF8 + + disposables.Register( + { new IDisposable with + member _.Dispose() = + Console.OutputEncoding <- previousEncoding + } + ) + // Display the banner text, if necessary if not bannerAlreadyPrinted then Console.Write(GetBannerText tcConfigB) @@ -1242,16 +1250,6 @@ let CompileFromCommandLineArguments ) = use disposables = new DisposablesTracker() - let savedOut = Console.Out - - use _ = - { new IDisposable with - member _.Dispose() = - try - Console.SetOut(savedOut) - with _ -> - () - } main1 ( ctok, diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 74fcc37340c..c1c60d6e47d 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -846,7 +846,7 @@ type internal FsiStdinSyphon(errorWriter: TextWriter) = /// Encapsulates functions used to write to outWriter and errorWriter type internal FsiConsoleOutput(tcConfigB, outWriter: TextWriter, errorWriter: TextWriter) = - let nullOut = new StreamWriter(Stream.Null) :> TextWriter + let nullOut = TextWriter.Null let fprintfnn (os: TextWriter) fmt = Printf.kfprintf @@ -1203,11 +1203,6 @@ type internal FsiCommandLineOptions(fsi: FsiEvaluationSessionHostConfig, argv: s if tcConfigB.clearResultsCache then dependencyProvider.ClearResultsCache(tcConfigB.compilerToolPaths, getOutputDir tcConfigB, reportError rangeCmdArgs) - if tcConfigB.utf8output then - let prev = Console.OutputEncoding - Console.OutputEncoding <- Encoding.UTF8 - System.AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> Console.OutputEncoding <- prev) - do let firstArg = match sourceFiles with @@ -4646,6 +4641,20 @@ type FsiEvaluationSession with e -> warning (e) + let restoreEncoding = + if tcConfigB.utf8output && Console.OutputEncoding <> Text.Encoding.UTF8 then + let previousEncoding = Console.OutputEncoding + Console.OutputEncoding <- Encoding.UTF8 + + Some( + { new IDisposable with + member _.Dispose() = + Console.OutputEncoding <- previousEncoding + } + ) + else + None + do updateBannerText () // resetting banner text after parsing options @@ -4789,6 +4798,7 @@ type FsiEvaluationSession member _.Dispose() = (tcImports :> IDisposable).Dispose() uninstallMagicAssemblyResolution.Dispose() + restoreEncoding |> Option.iter (fun x -> x.Dispose()) /// Load the dummy interaction, load the initial files, and, /// if interacting, start the background thread to read the standard input. diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index 5f6588bd770..3e42e03223c 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -100,14 +100,6 @@ module CompileHelpers = diagnostics.ToArray(), result - let setOutputStreams execute = - // Set the output streams, if requested - match execute with - | Some(writer, error) -> - Console.SetOut writer - Console.SetError error - | None -> () - [] // There is typically only one instance of this type in an IDE process. type FSharpChecker diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index e09c650e39b..3744167dd1a 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -137,7 +137,7 @@ module internal PervasiveAutoOpens = type Async with static member RunImmediate(computation: Async<'T>, ?cancellationToken) = - let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken + let cancellationToken = defaultArg cancellationToken CancellationToken.None let ts = TaskCompletionSource<'T>() diff --git a/src/FSharp.Core/mailbox.fs b/src/FSharp.Core/mailbox.fs index a938263a05b..a6fdd418e26 100644 --- a/src/FSharp.Core/mailbox.fs +++ b/src/FSharp.Core/mailbox.fs @@ -340,10 +340,11 @@ type Mailbox<'Msg>(cancellationSupported: bool, isThrowExceptionAfterDisposed: b inboxStore.Clear() arrivals.Clear() - isDisposed <- true) + isDisposed <- true - if isNotNull pulse then - (pulse :> IDisposable).Dispose() + if isNotNull pulse then + (pulse :> IDisposable).Dispose() + pulse <- null) #if DEBUG member x.UnsafeContents = (x.inbox, arrivals, pulse, savedCont) |> box diff --git a/src/fsi/fsimain.fs b/src/fsi/fsimain.fs index c13f37c11bc..4b9e92704a7 100644 --- a/src/fsi/fsimain.fs +++ b/src/fsi/fsimain.fs @@ -358,16 +358,6 @@ let evaluateSession (argv: string[]) = let MainMain argv = ignore argv let argv = System.Environment.GetCommandLineArgs() - let savedOut = Console.Out - - use __ = - { new IDisposable with - member _.Dispose() = - try - Console.SetOut(savedOut) - with _ -> - () - } let timesFlag = argv |> Array.exists (fun x -> x = "/times" || x = "--times") diff --git a/tests/EndToEndBuildTests/BasicProvider/BasicProvider.Tests/BasicProvider.Tests.fsproj b/tests/EndToEndBuildTests/BasicProvider/BasicProvider.Tests/BasicProvider.Tests.fsproj index 4e4aef01856..b98bced9759 100644 --- a/tests/EndToEndBuildTests/BasicProvider/BasicProvider.Tests/BasicProvider.Tests.fsproj +++ b/tests/EndToEndBuildTests/BasicProvider/BasicProvider.Tests/BasicProvider.Tests.fsproj @@ -21,7 +21,7 @@ content\myfiles\ - + diff --git a/tests/EndToEndBuildTests/ComboProvider/ComboProvider.Tests/ComboProvider.Tests.fsproj b/tests/EndToEndBuildTests/ComboProvider/ComboProvider.Tests/ComboProvider.Tests.fsproj index d4d410bacd4..0135c83f57d 100644 --- a/tests/EndToEndBuildTests/ComboProvider/ComboProvider.Tests/ComboProvider.Tests.fsproj +++ b/tests/EndToEndBuildTests/ComboProvider/ComboProvider.Tests/ComboProvider.Tests.fsproj @@ -18,7 +18,8 @@ - + + diff --git a/tests/FSharp.Build.UnitTests/FSharp.Build.UnitTests.fsproj b/tests/FSharp.Build.UnitTests/FSharp.Build.UnitTests.fsproj index 0a2421f3262..853737b3ca8 100644 --- a/tests/FSharp.Build.UnitTests/FSharp.Build.UnitTests.fsproj +++ b/tests/FSharp.Build.UnitTests/FSharp.Build.UnitTests.fsproj @@ -4,17 +4,26 @@ net472;$(FSharpNetCoreProductTargetFramework) - $(FSharpNetCoreProductTargetFramework) + $(FSharpNetCoreProductTargetFramework) Library true xunit + + XunitSetup.fs + + + + PreserveNewest + + + diff --git a/tests/FSharp.Build.UnitTests/xunit.runner.json b/tests/FSharp.Build.UnitTests/xunit.runner.json new file mode 100644 index 00000000000..b01c50a3cb5 --- /dev/null +++ b/tests/FSharp.Build.UnitTests/xunit.runner.json @@ -0,0 +1,5 @@ +{ + "$schema": "https://xunit.net/schema/current/xunit.runner.schema.json", + "appDomain": "denied", + "parallelizeAssembly": true +} diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/utf8output.fs b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/utf8output.fs new file mode 100644 index 00000000000..650bb63c76a --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/utf8output.fs @@ -0,0 +1,46 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace CompilerOptions.Fsc + +open Xunit +open FSharp.Test +open FSharp.Test.Compiler +open System + +[] +module utf8output = + + [] + let ``OutputEncoding is restored after executing compilation`` () = + let currentEncoding = Console.OutputEncoding + use restoreCurrentEncodingAfterTest = { new IDisposable with member _.Dispose() = Console.OutputEncoding <- currentEncoding } + + let encoding = Text.Encoding.GetEncoding("iso-8859-1") + + Console.OutputEncoding <- encoding + + Fs """printfn "Hello world" """ + |> asExe + |> withOptionsString "--utf8output" + |> compile + |> shouldSucceed + |> ignore + + Console.OutputEncoding.BodyName |> Assert.shouldBe encoding.BodyName + + [] + let ``OutputEncoding is restored after running script`` () = + let currentEncoding = Console.OutputEncoding + use restoreCurrentEncodingAfterTest = { new IDisposable with member _.Dispose() = Console.OutputEncoding <- currentEncoding } + + let encoding = Text.Encoding.GetEncoding("iso-8859-1") + + Console.OutputEncoding <- encoding + + Fsx """printfn "Hello world" """ + |> withOptionsString "--utf8output" + |> runFsi + |> shouldSucceed + |> ignore + + Console.OutputEncoding.BodyName |> Assert.shouldBe encoding.BodyName diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/times/times.fs b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/times/times.fs index b18e5472ec0..ba9c58eb3a8 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/times/times.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/times/times.fs @@ -8,6 +8,8 @@ open FSharp.Test.Compiler open System open System.IO +// reportTime uses global state. +[] module times = // This test was automatically generated (moved from FSharpQA suite - CompilerOptions/fsc/times) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AssemblyVersion04.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AssemblyVersion04.fs index 2a67d906999..fd876e72abb 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AssemblyVersion04.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AssemblyVersion04.fs @@ -14,5 +14,5 @@ let success = asm.Version.Major = 1 && asm.Version.Minor = 2 && asm.Version.Build = 3 && - (abs (asm.Version.Revision - (int defaultRevision))) < 10 // default value is seconds in the current day / 2. Check if within 10 sec of that. + (abs (asm.Version.Revision - (int defaultRevision))) < 60 // default value is seconds in the current day / 2. Check if within 60 sec of that. if success then () else failwith "Failed: 1" \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/Events/Basic/Basic.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/Events/Basic/Basic.fs index 87d12baea7c..911891a3320 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/Events/Basic/Basic.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/Events/Basic/Basic.fs @@ -6,6 +6,7 @@ open Xunit open FSharp.Test open FSharp.Test.Compiler +[] module Events = let verifyCompile compilation = diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TryCatch/TryCatch.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TryCatch/TryCatch.fs index 1e5187167a7..70ca6baa84e 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/TryCatch/TryCatch.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/TryCatch/TryCatch.fs @@ -56,9 +56,9 @@ let ``Stackoverflow reproduction`` compilation = | CompilationResult.Success ({OutputPath = Some dllFile} as s) -> let fsharpCoreFile = typeof>.Assembly.Location File.Copy(fsharpCoreFile, Path.Combine(Path.GetDirectoryName(dllFile), Path.GetFileName(fsharpCoreFile)), true) - let _exitCode, _stdout, stderr, _exn = CompilerAssert.ExecuteAndReturnResult (dllFile, isFsx=false, deps = s.Dependencies, newProcess=true) + let result = CompilerAssert.ExecuteAndReturnResult (dllFile, isFsx=false, deps = s.Dependencies, newProcess=true) - Assert.True(stderr.Contains "stack overflow" || stderr.Contains "StackOverflow") + Assert.True(result.StdErr.Contains "stack overflow" || result.StdErr.Contains "StackOverflow") | _ -> failwith (sprintf "%A" compilationResult) diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index af431847400..273194c8927 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -31,6 +31,9 @@ FsUnit.fs + + XunitSetup.fs + @@ -288,6 +291,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs index 0395a421895..8bc9ac09f05 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs +++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs @@ -13,6 +13,7 @@ open FSharp.Compiler.Diagnostics open Xunit +open FSharp.Test open FSharp.Test.ProjectGeneration open FSharp.Test.ProjectGeneration.Helpers open System.IO @@ -1064,67 +1065,71 @@ type private LoadClosureTestShim(currentFileSystem: IFileSystem) = ?shouldShadowCopy = shouldShadowCopy ) -[] -[] -[] -let ``The script load closure should always be evaluated`` useTransparentCompiler = - async { - // The LoadScriptClosure uses the file system shim so we need to reset that. - let currentFileSystem = FileSystemAutoOpens.FileSystem - let assumeDotNetFramework = - // The old BackgroundCompiler uses assumeDotNetFramework = true - // This is not always correctly loading when this test runs on non-Windows. - if System.Runtime.InteropServices.RuntimeInformation.FrameworkDescription.StartsWith(".NET Framework") then - None - else - Some false +// Because it is mutating FileSystem! +[] +module TestsMutatingFileSystem = + + [] + [] + [] + let ``The script load closure should always be evaluated`` useTransparentCompiler = + async { + // The LoadScriptClosure uses the file system shim so we need to reset that. + let currentFileSystem = FileSystemAutoOpens.FileSystem + let assumeDotNetFramework = + // The old BackgroundCompiler uses assumeDotNetFramework = true + // This is not always correctly loading when this test runs on non-Windows. + if System.Runtime.InteropServices.RuntimeInformation.FrameworkDescription.StartsWith(".NET Framework") then + None + else + Some false - try - let checker = FSharpChecker.Create(useTransparentCompiler = useTransparentCompiler) - let fileSystemShim = LoadClosureTestShim(currentFileSystem) - // Override the file system shim for loading b.fsx - FileSystem <- fileSystemShim - - let! initialSnapshot, _ = - checker.GetProjectSnapshotFromScript( - "a.fsx", - SourceTextNew.ofString fileSystemShim.aFsx, - documentSource = DocumentSource.Custom fileSystemShim.DocumentSource, - ?assumeDotNetFramework = assumeDotNetFramework - ) - - // File b.fsx should also be included in the snapshot. - Assert.Equal(2, initialSnapshot.SourceFiles.Length) - - let! checkResults = checker.ParseAndCheckFileInProject("a.fsx", initialSnapshot) - - match snd checkResults with - | FSharpCheckFileAnswer.Aborted -> failwith "Did not expected FSharpCheckFileAnswer.Aborted" - | FSharpCheckFileAnswer.Succeeded checkFileResults -> Assert.Equal(0, checkFileResults.Diagnostics.Length) + try + let checker = FSharpChecker.Create(useTransparentCompiler = useTransparentCompiler) + let fileSystemShim = LoadClosureTestShim(currentFileSystem) + // Override the file system shim for loading b.fsx + FileSystem <- fileSystemShim + + let! initialSnapshot, _ = + checker.GetProjectSnapshotFromScript( + "a.fsx", + SourceTextNew.ofString fileSystemShim.aFsx, + documentSource = DocumentSource.Custom fileSystemShim.DocumentSource, + ?assumeDotNetFramework = assumeDotNetFramework + ) + + // File b.fsx should also be included in the snapshot. + Assert.Equal(2, initialSnapshot.SourceFiles.Length) + + let! checkResults = checker.ParseAndCheckFileInProject("a.fsx", initialSnapshot) + + match snd checkResults with + | FSharpCheckFileAnswer.Aborted -> failwith "Did not expected FSharpCheckFileAnswer.Aborted" + | FSharpCheckFileAnswer.Succeeded checkFileResults -> Assert.Equal(0, checkFileResults.Diagnostics.Length) - // Update b.fsx, it should now load c.fsx - fileSystemShim.UpdateB() - - // The constructed key for the load closure will the exactly the same as the first GetProjectSnapshotFromScript call. - // However, a none cached version will be computed first in GetProjectSnapshotFromScript and update the cache afterwards. - let! secondSnapshot, _ = - checker.GetProjectSnapshotFromScript( - "a.fsx", - SourceTextNew.ofString fileSystemShim.aFsx, - documentSource = DocumentSource.Custom fileSystemShim.DocumentSource, - ?assumeDotNetFramework = assumeDotNetFramework - ) - - Assert.Equal(3, secondSnapshot.SourceFiles.Length) - - let! checkResults = checker.ParseAndCheckFileInProject("a.fsx", secondSnapshot) - - match snd checkResults with - | FSharpCheckFileAnswer.Aborted -> failwith "Did not expected FSharpCheckFileAnswer.Aborted" - | FSharpCheckFileAnswer.Succeeded checkFileResults -> Assert.Equal(0, checkFileResults.Diagnostics.Length) - finally - FileSystemAutoOpens.FileSystem <- currentFileSystem - } + // Update b.fsx, it should now load c.fsx + fileSystemShim.UpdateB() + + // The constructed key for the load closure will the exactly the same as the first GetProjectSnapshotFromScript call. + // However, a none cached version will be computed first in GetProjectSnapshotFromScript and update the cache afterwards. + let! secondSnapshot, _ = + checker.GetProjectSnapshotFromScript( + "a.fsx", + SourceTextNew.ofString fileSystemShim.aFsx, + documentSource = DocumentSource.Custom fileSystemShim.DocumentSource, + ?assumeDotNetFramework = assumeDotNetFramework + ) + + Assert.Equal(3, secondSnapshot.SourceFiles.Length) + + let! checkResults = checker.ParseAndCheckFileInProject("a.fsx", secondSnapshot) + + match snd checkResults with + | FSharpCheckFileAnswer.Aborted -> failwith "Did not expected FSharpCheckFileAnswer.Aborted" + | FSharpCheckFileAnswer.Succeeded checkFileResults -> Assert.Equal(0, checkFileResults.Diagnostics.Length) + finally + FileSystemAutoOpens.FileSystem <- currentFileSystem + } [] let ``Parsing without cache and without project snapshot`` () = diff --git a/tests/FSharp.Compiler.ComponentTests/Language/BooleanReturningAndReturnTypeDirectedPartialActivePatternTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/BooleanReturningAndReturnTypeDirectedPartialActivePatternTests.fs index 6562e347bbd..b9b155d3394 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/BooleanReturningAndReturnTypeDirectedPartialActivePatternTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/BooleanReturningAndReturnTypeDirectedPartialActivePatternTests.fs @@ -1,5 +1,7 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Because of shared fsi session. +[] module Language.BooleanReturningAndReturnTypeDirectedPartialActivePatternTests open Xunit diff --git a/tests/FSharp.Compiler.ComponentTests/Language/SequenceExpressions/SequenceExpressionTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/SequenceExpressions/SequenceExpressionTests.fs index 263f305f7a5..215791efbc2 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/SequenceExpressions/SequenceExpressionTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/SequenceExpressions/SequenceExpressionTests.fs @@ -1,5 +1,7 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Run sequentially because of shared fsiSession. +[] module Language.SequenceExpression.SequenceExpressionTests open FSharp.Test diff --git a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FsharpSuiteMigrated.fs b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FsharpSuiteMigrated.fs index 3f17e0cfa11..16c90229498 100644 --- a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FsharpSuiteMigrated.fs +++ b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FsharpSuiteMigrated.fs @@ -35,13 +35,15 @@ module ScriptRunner = let res = evalScriptFromDiskInSharedSession engine cu match res with | CompilationResult.Failure _ -> res - | CompilationResult.Success s -> - if engine.GetOutput().Contains "TEST PASSED OK" then + | CompilationResult.Success _ -> + if TestConsole.OutText |> TestFramework.outputPassed then res else - failwith $"Results looked correct, but 'TEST PASSED OK' was not printed. Result: %A{s}" + failwith $"Results looked correct, but 'TEST PASSED OK' was not printed." - | _ -> failwith $"Compilation unit other than fsharp is not supported, cannot process %A{cu}" + | _ -> + printfn $"Cannot process %A{cu}" + failwith $"Compilation unit other than fsharp is not supported." /// This test file was created by porting over (slower) FsharpSuite.Tests /// In order to minimize human error, the test definitions have been copy-pasted and this adapter provides implementations of the test functions diff --git a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/MigratedCoreTests.fs b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/MigratedCoreTests.fs index 2d9c6657901..df05c9808ff 100644 --- a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/MigratedCoreTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/MigratedCoreTests.fs @@ -93,14 +93,17 @@ let ``comprehensions-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/comprehens [] let ``comprehensions-FSI`` () = singleTestBuildAndRun "core/comprehensions" FSI -[] -let ``comprehensionshw-FSC_DEBUG`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_DEBUG +// Cancels default token. +[] +module Comprehensionshw = + [] + let ``comprehensionshw-FSC_DEBUG`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_DEBUG -[] -let ``comprehensionshw-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_OPTIMIZED + [] + let ``comprehensionshw-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/comprehensions-hw" FSC_OPTIMIZED -[] -let ``comprehensionshw-FSI`` () = singleTestBuildAndRun "core/comprehensions-hw" FSI + [] + let ``comprehensionshw-FSI`` () = singleTestBuildAndRun "core/comprehensions-hw" FSI [] let ``genericmeasures-FSC_DEBUG`` () = singleTestBuildAndRun "core/genericmeasures" FSC_DEBUG @@ -375,18 +378,21 @@ let ``recordResolution-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/recordRe [] let ``recordResolution-FSI`` () = singleTestBuildAndRun "core/recordResolution" FSI -// This test has hardcoded expectations about current synchronization context -// Will be moved out of FsharpSuite.Tests in a later phase for desktop framework -[] -let ``control-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/control" FSC_OPTIMIZED +// Cancels default token. +[] +module CoreControl = + // This test has hardcoded expectations about current synchronization context + // Will be moved out of FsharpSuite.Tests in a later phase for desktop framework + [] + let ``control-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/control" FSC_OPTIMIZED -[] -let ``control-FSI`` () = singleTestBuildAndRun "core/control" FSI + [] + let ``control-FSI`` () = singleTestBuildAndRun "core/control" FSI -[] -let ``control --tailcalls`` () = - let cfg = "core/control" - singleTestBuildAndRunAux cfg ["--tailcalls"] FSC_OPTIMIZED + [] + let ``control --tailcalls`` () = + let cfg = "core/control" + singleTestBuildAndRunAux cfg ["--tailcalls"] FSC_OPTIMIZED [] let ``controlChamenos-FSC_OPTIMIZED`` () = @@ -401,7 +407,7 @@ let ``controlChamenos-FSI`` () = [] let ``controlMailbox-FSC_OPTIMIZED`` () = singleTestBuildAndRun "core/controlMailbox" FSC_OPTIMIZED -[] +[] let ``controlMailbox-FSI`` () = singleTestBuildAndRun "core/controlMailbox" FSI [] diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Utils.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Utils.fs index d14ddb44de1..9e7d2f46863 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Utils.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/Utils.fs @@ -5,7 +5,7 @@ open FSharp.Compiler.GraphChecking open FSharp.Compiler.Text open FSharp.Compiler.Syntax -let private checker = FSharpChecker.Create() +open FSharp.Test let parseSourceCode (name: string, code: string) = let sourceText = SourceText.ofString code @@ -16,7 +16,7 @@ let parseSourceCode (name: string, code: string) = } let result = - checker.ParseFile(name, sourceText, parsingOptions) |> Async.RunSynchronously + TestContext.Checker.ParseFile(name, sourceText, parsingOptions) |> Async.RunSynchronously result.ParseTree diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/TyparNameTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/TyparNameTests.fs index d8316d365e7..e8df564a776 100644 --- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/TyparNameTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/TyparNameTests.fs @@ -14,7 +14,7 @@ module TyparNameTests = (additionalFile: SourceCodeFileKind) : string array = let typeCheckResult = - cUnit |> withAdditionalSourceFile additionalFile |> typecheckProject false CompilerAssertHelpers.UseTransparentCompiler + cUnit |> withAdditionalSourceFile additionalFile |> typecheckProject false TestContext.UseTransparentCompiler assert (Array.isEmpty typeCheckResult.Diagnostics) diff --git a/tests/FSharp.Compiler.ComponentTests/xunit.runner.json b/tests/FSharp.Compiler.ComponentTests/xunit.runner.json index 2d07715ae5f..b01c50a3cb5 100644 --- a/tests/FSharp.Compiler.ComponentTests/xunit.runner.json +++ b/tests/FSharp.Compiler.ComponentTests/xunit.runner.json @@ -1,7 +1,5 @@ { - "$schema": "https://xunit.net/schema/current/xunit.runner.schema.json", - "appDomain": "ifAvailable", - "shadowCopy": false, - "parallelizeTestCollections": false, - "maxParallelThreads": 1 + "$schema": "https://xunit.net/schema/current/xunit.runner.schema.json", + "appDomain": "denied", + "parallelizeAssembly": true } diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/DependencyManagerInteractiveTests.fs b/tests/FSharp.Compiler.Private.Scripting.UnitTests/DependencyManagerInteractiveTests.fs index cc027d098af..8b4be398ddd 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/DependencyManagerInteractiveTests.fs +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/DependencyManagerInteractiveTests.fs @@ -13,6 +13,7 @@ open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.DependencyManager.Nuget open FSharp.Test.ScriptHelpers +open FSharp.Test open FSharp.Test.Utilities open Internal.Utilities @@ -25,6 +26,7 @@ module Native = type scriptHost (?langVersion: LangVersion) = inherit FSharpScript(langVersion=defaultArg langVersion LangVersion.Preview) +[] type DependencyManagerInteractiveTests() = let getValue ((value: Result), (errors: FSharpDiagnostic[])) = @@ -148,8 +150,7 @@ type DependencyManagerInteractiveTests() = Assert.Equal(0, result.Roots |> Seq.length) () - - [] + [] member _.``Multiple Instances of DependencyProvider should be isolated``() = let assemblyProbingPaths () = Seq.empty diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharp.Compiler.Private.Scripting.UnitTests.fsproj b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharp.Compiler.Private.Scripting.UnitTests.fsproj index 3bf2d528a4f..e0d064e12f9 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharp.Compiler.Private.Scripting.UnitTests.fsproj +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharp.Compiler.Private.Scripting.UnitTests.fsproj @@ -3,7 +3,7 @@ net472;$(FSharpNetCoreProductTargetFramework) - $(FSharpNetCoreProductTargetFramework) + $(FSharpNetCoreProductTargetFramework) Library true xunit @@ -12,6 +12,9 @@ + + XunitSetup.fs + diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs index bf3a9cbaac6..6bbf60a8dcc 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs @@ -85,7 +85,7 @@ x ) #endif - [] + [] member _.``Capture console input``() = use script = new FSharpScript(input = "stdin:1234\r\n") let opt = script.Eval("System.Console.ReadLine()") |> getValue @@ -93,7 +93,7 @@ x Assert.Equal(typeof, value.ReflectionType) Assert.Equal("stdin:1234", downcast value.ReflectionValue) - [] + [] member _.``Capture console output/error``() = use script = new FSharpScript() use sawOutputSentinel = new ManualResetEvent(false) @@ -479,6 +479,9 @@ let x = script.Eval(code) |> ignoreValue Assert.False(foundInner) +// Fails in NETFRAMEWORK with exception +// System.MissingMethodException : Method not found: 'Microsoft.FSharp.Core.FSharpFunc`2,FParsec.Reply`1> FParsec.CharParsers.pfloat()'. +#if NETCOREAPP [] member _.``Script with nuget package that yields out of order dependencies works correctly``() = // regression test for: https://github.com/dotnet/fsharp/issues/9217 @@ -501,6 +504,7 @@ test pfloat "1.234" let opt = script.Eval(code) |> getValue let value = opt.Value Assert.True(true = downcast value.ReflectionValue) +#endif [] member _.``Nuget package with method duplicates differing only in generic arity``() = diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/xunit.runner.json b/tests/FSharp.Compiler.Private.Scripting.UnitTests/xunit.runner.json index 2d07715ae5f..b01c50a3cb5 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/xunit.runner.json +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/xunit.runner.json @@ -1,7 +1,5 @@ { - "$schema": "https://xunit.net/schema/current/xunit.runner.schema.json", - "appDomain": "ifAvailable", - "shadowCopy": false, - "parallelizeTestCollections": false, - "maxParallelThreads": 1 + "$schema": "https://xunit.net/schema/current/xunit.runner.schema.json", + "appDomain": "denied", + "parallelizeAssembly": true } diff --git a/tests/FSharp.Compiler.Service.Tests/AssemblyContentProviderTests.fs b/tests/FSharp.Compiler.Service.Tests/AssemblyContentProviderTests.fs index cb4521b7af4..b7d2a4add83 100644 --- a/tests/FSharp.Compiler.Service.Tests/AssemblyContentProviderTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/AssemblyContentProviderTests.fs @@ -22,7 +22,7 @@ let private projectOptions : FSharpProjectOptions = UnresolvedReferences = None Stamp = None } -let private checker = FSharpChecker.Create(useTransparentCompiler=CompilerAssertHelpers.UseTransparentCompiler) +let private checker = FSharpChecker.Create(useTransparentCompiler = TestContext.UseTransparentCompiler) let private assertAreEqual (expected, actual) = if actual <> expected then diff --git a/tests/FSharp.Compiler.Service.Tests/Common.fs b/tests/FSharp.Compiler.Service.Tests/Common.fs index df51f666ccd..4eb05598d52 100644 --- a/tests/FSharp.Compiler.Service.Tests/Common.fs +++ b/tests/FSharp.Compiler.Service.Tests/Common.fs @@ -19,7 +19,7 @@ open FSharp.Test.Utilities type Async with static member RunImmediate (computation: Async<'T>, ?cancellationToken ) = - let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken + let cancellationToken = defaultArg cancellationToken CancellationToken.None let ts = TaskCompletionSource<'T>() let task = ts.Task Async.StartWithContinuations( @@ -31,7 +31,7 @@ type Async with task.Result // Create one global interactive checker instance -let checker = FSharpChecker.Create(useTransparentCompiler=FSharp.Compiler.CompilerConfig.FSharpExperimentalFeaturesEnabledAutomatically) +let checker = FSharpChecker.Create(useTransparentCompiler = FSharp.Test.TestContext.UseTransparentCompiler) type TempFile(ext, contents: string) = let tmpFile = Path.ChangeExtension(getTemporaryFileName (), ext) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj index 9f0c7f230b9..831143ba698 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -24,6 +24,9 @@ FsUnit.fs + + XunitSetup.fs + diff --git a/tests/FSharp.Compiler.Service.Tests/FSharpExprPatternsTests.fs b/tests/FSharp.Compiler.Service.Tests/FSharpExprPatternsTests.fs index abc6bbc9de4..b9367b12759 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharpExprPatternsTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/FSharpExprPatternsTests.fs @@ -139,7 +139,7 @@ let testPatterns handler source = } let checker = - FSharpChecker.Create(documentSource = DocumentSource.Custom documentSource, keepAssemblyContents = true, useTransparentCompiler = CompilerAssertHelpers.UseTransparentCompiler) + FSharpChecker.Create(documentSource = DocumentSource.Custom documentSource, keepAssemblyContents = true, useTransparentCompiler = TestContext.UseTransparentCompiler) let checkResult = checker.ParseAndCheckFileInProject("A.fs", 0, Map.find "A.fs" files, projectOptions) diff --git a/tests/FSharp.Compiler.Service.Tests/FileSystemTests.fs b/tests/FSharp.Compiler.Service.Tests/FileSystemTests.fs index 77a1d657308..f5170d0c4e5 100644 --- a/tests/FSharp.Compiler.Service.Tests/FileSystemTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/FileSystemTests.fs @@ -25,6 +25,8 @@ let file2 = """ module File2 let B = File1.A + File1.A""" +// FileSystem is a global shared resource. +[] type internal MyFileSystem() = inherit DefaultFileSystem() static member FilesCache = dict [(fileName1, file1); (fileName2, file2)] diff --git a/tests/FSharp.Compiler.Service.Tests/FsiHelpTests.fs b/tests/FSharp.Compiler.Service.Tests/FsiHelpTests.fs index d17b3421ed9..110cc1a09e7 100644 --- a/tests/FSharp.Compiler.Service.Tests/FsiHelpTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/FsiHelpTests.fs @@ -3,7 +3,6 @@ open FSharp.Test.Assert open Xunit -[] module FsiHelpTests = [] diff --git a/tests/FSharp.Compiler.Service.Tests/FsiTests.fs b/tests/FSharp.Compiler.Service.Tests/FsiTests.fs index f6a785af4f1..ccd0668f3ae 100644 --- a/tests/FSharp.Compiler.Service.Tests/FsiTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/FsiTests.fs @@ -14,21 +14,15 @@ type Sentinel () = module MyModule = let test(x: int) = () -[] module FsiTests = let createFsiSession (useOneDynamicAssembly: bool) = - // Initialize output and input streams - let inStream = new StringReader("") - let outStream = new CompilerOutputStream() - let errStream = new CompilerOutputStream() - // Build command line arguments & start FSI session let argv = [| "C:\\fsi.exe" |] let allArgs = Array.append argv [|"--noninteractive"; if useOneDynamicAssembly then "--multiemit-" else "--multiemit+" |] let fsiConfig = FsiEvaluationSession.GetDefaultConfiguration() - FsiEvaluationSession.Create(fsiConfig, allArgs, inStream, new StreamWriter(outStream), new StreamWriter(errStream), collectible = true) + FsiEvaluationSession.Create(fsiConfig, allArgs, TextReader.Null, TextWriter.Null, TextWriter.Null, collectible = true) [] let ``No bound values at the start of FSI session`` () = diff --git a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs index 5752f9de41c..807fa90c78c 100644 --- a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs @@ -19,6 +19,8 @@ open FSharp.Compiler.Symbols open FSharp.Compiler.Symbols.FSharpExprPatterns open TestFramework +// Exculde because of some GC tests +[] module internal Project1 = let fileName1 = Path.ChangeExtension(getTemporaryFileName (), ".fs") @@ -126,7 +128,7 @@ let ``Test project1 and make sure TcImports gets cleaned up`` () = //collect 2 more times for good measure, // See for example: https://github.com/dotnet/runtime/discussions/108081 - GC.Collect() + GC.Collect(2, GCCollectionMode.Forced, true) GC.WaitForPendingFinalizers() GC.Collect() GC.WaitForPendingFinalizers() diff --git a/tests/FSharp.Compiler.Service.Tests/TooltipTests.fs b/tests/FSharp.Compiler.Service.Tests/TooltipTests.fs index 0b30a5a61e8..2dc445199b3 100644 --- a/tests/FSharp.Compiler.Service.Tests/TooltipTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/TooltipTests.fs @@ -33,7 +33,7 @@ let testXmlDocFallbackToSigFileWhileInImplFile sigSource implSource line colAtEn let checker = FSharpChecker.Create(documentSource = DocumentSource.Custom documentSource, - useTransparentCompiler = CompilerAssertHelpers.UseTransparentCompiler) + useTransparentCompiler = TestContext.UseTransparentCompiler) let checkResult = checker.ParseAndCheckFileInProject("A.fs", 0, Map.find "A.fs" files, projectOptions) @@ -281,7 +281,7 @@ let testToolTipSquashing source line colAtEndOfNames lineText names tokenTag = let checker = FSharpChecker.Create(documentSource = DocumentSource.Custom documentSource, - useTransparentCompiler = CompilerAssertHelpers.UseTransparentCompiler) + useTransparentCompiler = TestContext.UseTransparentCompiler) let checkResult = checker.ParseAndCheckFileInProject("A.fs", 0, Map.find "A.fs" files, projectOptions) diff --git a/tests/FSharp.Compiler.Service.Tests/xunit.runner.json b/tests/FSharp.Compiler.Service.Tests/xunit.runner.json index 743febb7028..b01c50a3cb5 100644 --- a/tests/FSharp.Compiler.Service.Tests/xunit.runner.json +++ b/tests/FSharp.Compiler.Service.Tests/xunit.runner.json @@ -1,5 +1,5 @@ { - "$schema": "https://xunit.net/schema/current/xunit.runner.schema.json", - "appDomain": "ifAvailable", - "shadowCopy": false + "$schema": "https://xunit.net/schema/current/xunit.runner.schema.json", + "appDomain": "denied", + "parallelizeAssembly": true } diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core.UnitTests.fsproj b/tests/FSharp.Core.UnitTests/FSharp.Core.UnitTests.fsproj index 2ba4f6f837d..3e6bbbd282d 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core.UnitTests.fsproj +++ b/tests/FSharp.Core.UnitTests/FSharp.Core.UnitTests.fsproj @@ -4,7 +4,7 @@ $(FSharpNetCoreProductTargetFramework);net472 - $(FSharpNetCoreProductTargetFramework) + $(FSharpNetCoreProductTargetFramework) Library FSharp.Core.UnitTests @@ -26,6 +26,9 @@ + + XunitSetup.fs + diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs index a8e42790090..6b63789f18a 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs @@ -1747,6 +1747,7 @@ module ComparersRegression = open ComparersRegression open Xunit +[] type GeneratedTests () = let _ = () // ------------------------------------------------------------------------------ diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index 213ff435adf..b8b5eedeb73 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -148,6 +148,7 @@ module LeakUtils = // --------------------------------------------------- +// [] type AsyncModule() = /// Simple asynchronous task that delays 200ms and returns a list of the current tick count @@ -377,25 +378,25 @@ type AsyncModule() = [] member _.``AwaitWaitHandle.DisposedWaitHandle2``() = - let wh = new ManualResetEvent(false) + let wh = new System.Threading.ManualResetEvent(false) let started = new ManualResetEventSlim(false) - - let test = - async { + let cts = new CancellationTokenSource() + let test = + Async.StartAsTask( async { + printfn "starting the test" started.Set() - let! timeout = Async.AwaitWaitHandle(wh, 5000) - Assert.False(timeout, "Timeout expected") - } - |> Async.StartAsTask - - task { - started.Wait() - // Wait a moment then dispose waithandle - nothing should happen - do! Task.Delay 500 - Assert.False(test.IsCompleted, "Test completed too early") - dispose wh - do! test - } + let! _ = Async.AwaitWaitHandle(wh) + printfn "should never get here" + }, cancellationToken = cts.Token) + + // Wait for the test to start then dispose waithandle - nothing should happen. + started.Wait() + Assert.False(test.Wait 100, "Test completed too early.") + printfn "disposing" + dispose wh + printfn "cancelling in 1 second" + cts.CancelAfter 1000 + Assert.ThrowsAsync(fun () -> test) [] member _.``RunSynchronously.NoThreadJumpsAndTimeout``() = @@ -469,21 +470,27 @@ type AsyncModule() = member _.``error on one workflow should cancel all others``() = task { use failOnlyOne = new Semaphore(0, 1) - let mutable cancelled = 0 - let mutable started = 0 + // Start from 1. + let mutable running = new CountdownEvent(1) let job i = async { - Interlocked.Increment &started |> ignore - use! holder = Async.OnCancel (fun () -> Interlocked.Increment &cancelled |> ignore) + running.AddCount 1 + use! holder = Async.OnCancel (running.Signal >> ignore) do! failOnlyOne |> Async.AwaitWaitHandle |> Async.Ignore + running.Signal() |> ignore failwith "boom" } let test = Async.Parallel [ for i in 1 .. 100 -> job i ] |> Async.Catch |> Async.Ignore |> Async.StartAsTask - do! Task.Delay 100 + // Wait for more than one job to start + while running.CurrentCount < 2 do + do! Task.Yield() + printfn $"started jobs: {running.CurrentCount - 1}" failOnlyOne.Release() |> ignore do! test - Assert.Equal(started - 1, cancelled) + // running.CurrentCount should eventually settle back at 1. Signal it one more time and it should be 0. + running.Signal() |> ignore + return! Async.AwaitWaitHandle running.WaitHandle } [] diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs index 1b15be8fa98..ebe2401f82e 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs @@ -11,6 +11,8 @@ open Xunit open System.Threading open System.Threading.Tasks +// Cancels default token. +[] module AsyncType = type ExpectedContinuation = Success | Exception | Cancellation @@ -38,8 +40,7 @@ module AsyncType = async { return () } |> expect Success - - +[] type AsyncType() = let ignoreSynchCtx f = @@ -67,6 +68,8 @@ type AsyncType() = |> Async.Parallel |> Async.RunSynchronously |> Set.ofArray + printfn $"RunSynchronously used {usedThreads.Count} threads. Environment.ProcessorCount is {Environment.ProcessorCount}." + // Some arbitrary large number but in practice it should not use more threads than there are CPU cores. Assert.True(usedThreads.Count < 256, $"RunSynchronously used {usedThreads.Count} threads.") [] diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs index cecfaec7590..5369edaf567 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs @@ -9,7 +9,7 @@ open FSharp.Test open System.Threading open System.Threading.Tasks - +[] type CancellationType() = [] diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs index f3964aaa78c..af3438b902b 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs @@ -24,6 +24,7 @@ type StartImmediateThreadInfo = type StartImmediateMessage = | GetThreadInfo of AsyncReplyChannel +[] type MailboxProcessorType() = let getSimpleMailbox() = diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs index 8097c2d10f5..130c99e8fea 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Tasks.fs @@ -192,6 +192,7 @@ module Helpers = let require x msg = if not x then failwith msg let failtest str = raise (TestException str) +[] type Basics() = [] member _.testShortCircuitResult() = @@ -1201,8 +1202,6 @@ type Basics() = } |> ignore -[] -type BasicsNotInParallel() = [] member _.testTaskUsesSyncContext() = diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs index 7f844e99d96..d62a8c6f1b9 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/TasksDynamic.fs @@ -313,6 +313,7 @@ module Helpers = let require x msg = if not x then failwith msg let failtest str = raise (TestException str) +[] type Basics() = [] member _.testShortCircuitResult() = @@ -1259,10 +1260,6 @@ type Basics() = } |> ignore - -[] -type BasicsNotInParallel() = - [] member _.testTaskUsesSyncContext() = printfn "Running testBackgroundTask..." diff --git a/tests/FSharp.Core.UnitTests/xunit.runner.json b/tests/FSharp.Core.UnitTests/xunit.runner.json index 2d07715ae5f..b01c50a3cb5 100644 --- a/tests/FSharp.Core.UnitTests/xunit.runner.json +++ b/tests/FSharp.Core.UnitTests/xunit.runner.json @@ -1,7 +1,5 @@ { - "$schema": "https://xunit.net/schema/current/xunit.runner.schema.json", - "appDomain": "ifAvailable", - "shadowCopy": false, - "parallelizeTestCollections": false, - "maxParallelThreads": 1 + "$schema": "https://xunit.net/schema/current/xunit.runner.schema.json", + "appDomain": "denied", + "parallelizeAssembly": true } diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index 5e5629b089f..5a8482e2204 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -170,16 +170,16 @@ module rec Compiler = Message: string SubCategory: string } - // This type is used either for the output of the compiler (typically in CompilationResult coming from 'compile') - // or for the output of the code generated by the compiler (in CompilationResult coming from 'run') - type ExecutionOutput = - { ExitCode: int option - StdOut: string - StdErr: string - Exn: exn option } +// This type is used either for the output of the compiler (typically in CompilationResult coming from 'compile') +// or for the output of the code generated by the compiler (in CompilationResult coming from 'run') + + type EvalOutput = + { Result: Result + StdOut: string + StdErr: string } type RunOutput = - | EvalOutput of Result + | EvalOutput of EvalOutput | ExecutionOutput of ExecutionOutput type SourceCodeFileName = string @@ -701,20 +701,21 @@ module rec Compiler = let private compileFSharpCompilation compilation ignoreWarnings (cUnit: CompilationUnit) : CompilationResult = - use redirect = new RedirectConsole() let ((err: FSharpDiagnostic[], exn, outputFilePath: string), deps) = CompilerAssert.CompileRaw(compilation, ignoreWarnings) // Create and stash the console output let diagnostics = err |> fromFSharpDiagnostic + let outcome = exn |> Option.map Failure |> Option.defaultValue NoExitCode + let result = { OutputPath = None Dependencies = deps Adjust = 0 PerFileErrors = diagnostics Diagnostics = diagnostics |> List.map snd - Output = Some (RunOutput.ExecutionOutput { ExitCode = None; StdOut = redirect.Output(); StdErr = redirect.ErrorOutput(); Exn = exn }) + Output = Some (RunOutput.ExecutionOutput { Outcome = outcome; StdOut = TestConsole.OutText; StdErr = TestConsole.ErrorText }) Compilation = cUnit } @@ -921,7 +922,6 @@ module rec Compiler = let fileName = fsSource.Source.ChangeExtension.GetSourceFileName let references = - let disposals = ResizeArray() let outputDirectory = match fsSource.OutputDirectory with | Some di -> di @@ -931,10 +931,9 @@ module rec Compiler = Array.empty else outputDirectory.Create() - disposals.Add({ new IDisposable with member _.Dispose() = outputDirectory.Delete(true) }) // Note that only the references are relevant here let compilation = Compilation.Compilation([], CompileOutput.Exe,Array.empty, TargetFramework.Current, references, None, None) - evaluateReferences outputDirectory disposals fsSource.IgnoreWarnings compilation + evaluateReferences outputDirectory fsSource.IgnoreWarnings compilation |> fst let options = @@ -981,19 +980,17 @@ module rec Compiler = | SourceCodeFileKind.Fsx _ -> true | _ -> false | _ -> false - let exitCode, output, errors, exn = CompilerAssert.ExecuteAndReturnResult (p, isFsx, s.Dependencies, false) - printfn "---------output-------\n%s\n-------" output - printfn "---------errors-------\n%s\n-------" errors - let executionResult = { s with Output = Some (ExecutionOutput { ExitCode = exitCode; StdOut = output; StdErr = errors; Exn = exn }) } - match exn with - | None -> CompilationResult.Success executionResult - | Some _ -> CompilationResult.Failure executionResult + let output = CompilerAssert.ExecuteAndReturnResult (p, isFsx, s.Dependencies, false) + let executionResult = { s with Output = Some (ExecutionOutput output) } + match output.Outcome with + | Failure _ -> CompilationResult.Failure executionResult + | _ -> CompilationResult.Success executionResult let compileAndRun = compile >> run let compileExeAndRun = asExe >> compileAndRun - let private processScriptResults fs (evalResult: Result, err: FSharpDiagnostic[]) = + let private processScriptResults fs (evalResult: Result, err: FSharpDiagnostic[]) outputWritten errorsWritten = let perFileDiagnostics = err |> fromFSharpDiagnostic let diagnostics = perFileDiagnostics |> List.map snd let (errors, warnings) = partitionErrors diagnostics @@ -1003,7 +1000,7 @@ module rec Compiler = Adjust = 0 Diagnostics = if fs.IgnoreWarnings then errors else diagnostics PerFileErrors = perFileDiagnostics - Output = Some (EvalOutput evalResult) + Output = Some (EvalOutput ({Result = evalResult; StdOut = outputWritten; StdErr = errorsWritten})) Compilation = FS fs } let evalError = match evalResult with Ok _ -> false | _ -> true @@ -1015,7 +1012,9 @@ module rec Compiler = let private evalFSharp (fs: FSharpCompilationSource) (script:FSharpScript) : CompilationResult = let source = fs.Source.GetSourceText |> Option.defaultValue "" - script.Eval(source) |> (processScriptResults fs) + let result = script.Eval(source) + let outputWritten, errorsWritten = TestConsole.OutText, TestConsole.ErrorText + processScriptResults fs result outputWritten errorsWritten let scriptingShim = Path.Combine(__SOURCE_DIRECTORY__,"ScriptingShims.fsx") let private evalScriptFromDisk (fs: FSharpCompilationSource) (script:FSharpScript) : CompilationResult = @@ -1027,7 +1026,9 @@ module rec Compiler = |> List.map (sprintf " @\"%s\"") |> String.Concat - script.Eval("#load " + fileNames ) |> (processScriptResults fs) + let result = script.Eval("#load " + fileNames) + let outputWritten, errorsWritten = TestConsole.OutText, TestConsole.ErrorText + processScriptResults fs result outputWritten errorsWritten let eval (cUnit: CompilationUnit) : CompilationResult = match cUnit with @@ -1037,7 +1038,7 @@ module rec Compiler = evalFSharp fs script | _ -> failwith "Script evaluation is only supported for F#." - let getSessionForEval args version = new FSharpScript(additionalArgs=args,quiet=false,langVersion=version) + let getSessionForEval args version = new FSharpScript(additionalArgs=args,quiet=true,langVersion=version) let evalInSharedSession (script:FSharpScript) (cUnit: CompilationUnit) : CompilationResult = match cUnit with @@ -1052,58 +1053,51 @@ module rec Compiler = let runFsi (cUnit: CompilationUnit) : CompilationResult = match cUnit with | FS fs -> - let disposals = ResizeArray() - try - let source = fs.Source.GetSourceText |> Option.defaultValue "" - let name = fs.Name |> Option.defaultValue "unnamed" - let options = fs.Options |> Array.ofList - let outputDirectory = - match fs.OutputDirectory with - | Some di -> di - | None -> DirectoryInfo(createTemporaryDirectory "runFsi") - outputDirectory.Create() - disposals.Add({ new IDisposable with member _.Dispose() = outputDirectory.Delete(true) }) - - let references = processReferences fs.References outputDirectory - let cmpl = Compilation.Create(fs.Source, fs.OutputType, options, fs.TargetFramework, references, name, outputDirectory) - let _compilationRefs, _deps = evaluateReferences outputDirectory disposals fs.IgnoreWarnings cmpl - let options = - let opts = new ResizeArray(fs.Options) - - // For every built reference add a -I path so that fsi can find it easily - for reference in references do - match reference with - | CompilationReference( cmpl, _) -> - match cmpl with - | Compilation(_sources, _outputType, _options, _targetFramework, _references, _name, outputDirectory) -> - if outputDirectory.IsSome then - opts.Add($"-I:\"{(outputDirectory.Value.FullName)}\"") - | _ -> () - opts.ToArray() - let errors, stdOut = CompilerAssert.RunScriptWithOptionsAndReturnResult options source - - let mkResult output = - { OutputPath = None - Dependencies = [] - Adjust = 0 - Diagnostics = [] - PerFileErrors= [] - Output = Some output - Compilation = cUnit } - - if errors.Count = 0 then - let output = - ExecutionOutput { ExitCode = None; StdOut = stdOut; StdErr = ""; Exn = None } - CompilationResult.Success (mkResult output) - else - let err = (errors |> String.concat "\n").Replace("\r\n","\n") - let output = - ExecutionOutput {ExitCode = None; StdOut = String.Empty; StdErr = err; Exn = None } - CompilationResult.Failure (mkResult output) - - finally - disposals - |> Seq.iter (fun x -> x.Dispose()) + let source = fs.Source.GetSourceText |> Option.defaultValue "" + let name = fs.Name |> Option.defaultValue "unnamed" + let options = fs.Options |> Array.ofList + let outputDirectory = + match fs.OutputDirectory with + | Some di -> di + | None -> DirectoryInfo(createTemporaryDirectory "runFsi") + outputDirectory.Create() + + let references = processReferences fs.References outputDirectory + let cmpl = Compilation.Create(fs.Source, fs.OutputType, options, fs.TargetFramework, references, name, outputDirectory) + let _compilationRefs, _deps = evaluateReferences outputDirectory fs.IgnoreWarnings cmpl + let options = + let opts = new ResizeArray(fs.Options) + + // For every built reference add a -I path so that fsi can find it easily + for reference in references do + match reference with + | CompilationReference( cmpl, _) -> + match cmpl with + | Compilation(_sources, _outputType, _options, _targetFramework, _references, _name, outputDirectory) -> + if outputDirectory.IsSome then + opts.Add($"-I:\"{(outputDirectory.Value.FullName)}\"") + | _ -> () + opts.ToArray() + let errors, stdOut, stdErr = CompilerAssert.RunScriptWithOptionsAndReturnResult options source + + let mkResult output = + { OutputPath = None + Dependencies = [] + Adjust = 0 + Diagnostics = [] + PerFileErrors= [] + Output = Some output + Compilation = cUnit } + + if errors.Count = 0 then + let output = + ExecutionOutput { Outcome = NoExitCode; StdOut = stdOut; StdErr = stdErr } + CompilationResult.Success (mkResult output) + else + let err = (errors |> String.concat "\n").Replace("\r\n","\n") + let output = + ExecutionOutput {Outcome = NoExitCode; StdOut = String.Empty; StdErr = err } + CompilationResult.Failure (mkResult output) | _ -> failwith "FSI running only supports F#." @@ -1190,9 +1184,11 @@ Actual: | Some p -> match ILChecker.verifyILAndReturnActual [] p expected with | true, _, _ -> result - | false, errorMsg, _actualIL -> CompilationResult.Failure( {s with Output = Some (ExecutionOutput {ExitCode = None; StdOut = errorMsg; StdErr = ""; Exn = None })} ) - - | CompilationResult.Failure f -> failwith $"Result should be \"Success\" in order to get IL. Failure: {Environment.NewLine}{f}" + | false, errorMsg, _actualIL -> CompilationResult.Failure( {s with Output = Some (ExecutionOutput {Outcome = NoExitCode; StdOut = errorMsg; StdErr = "" })} ) + | CompilationResult.Failure f -> + printfn "Failure:" + printfn $"{f}" + failwith $"Result should be \"Success\" in order to get IL." let verifyIL = doILCheck ILChecker.checkIL @@ -1282,7 +1278,7 @@ Actual: | Some actual -> let expected = stripVersion (normalizeNewlines expected) if expected <> actual then - failwith $"""Output does not match expected: ------------{Environment.NewLine}{expected}{Environment.NewLine}Actual: ------------{Environment.NewLine}{actual}{Environment.NewLine}""" + failwith $"""Output does not match expected:{Environment.NewLine}{expected}{Environment.NewLine}Actual:{Environment.NewLine}{actual}{Environment.NewLine}""" else cResult @@ -1295,7 +1291,7 @@ Actual: | Some actual -> for item in expected do if not(actual.Contains(item)) then - failwith $"""Output does not match expected: ------------{Environment.NewLine}{item}{Environment.NewLine}Actual: ------------{Environment.NewLine}{actual}{Environment.NewLine}""" + failwith $"""Output does not match expected:{Environment.NewLine}{item}{Environment.NewLine}Actual:{Environment.NewLine}{actual}{Environment.NewLine}""" cResult type ImportScope = { Kind: ImportDefinitionKind; Name: string } @@ -1515,18 +1511,15 @@ Actual: match result with | CompilationResult.Success _ -> result | CompilationResult.Failure r -> - let message = - [ sprintf "Operation failed (expected to succeed).\n All errors:\n%A\n" r.Diagnostics - match r.Output with - | Some (ExecutionOutput output) -> - sprintf "----output-----\n%s\n----error-------\n%s\n----------" output.StdOut output.StdErr - | Some (EvalOutput (Result.Error exn) ) -> - sprintf "----script error-----\n%s\n----------" (exn.ToString()) - | Some (EvalOutput (Result.Ok fsiVal) ) -> - sprintf "----script output-----\n%A\n----------" (fsiVal) - | _ -> () ] - |> String.concat "\n" - failwith message + eprintfn "\nAll errors:" + r.Diagnostics |> Seq.iter (eprintfn "%A") + + match r.Output with + | Some (EvalOutput { Result = Result.Error ex }) + | Some (ExecutionOutput {Outcome = Failure ex }) -> + raise ex + | _ -> + failwithf "Operation failed (expected to succeed)." let shouldFail (result: CompilationResult) : CompilationResult = match result with @@ -1706,13 +1699,15 @@ Actual: | None -> failwith "Execution output is missing, cannot check exit code." | Some o -> match o with - | ExecutionOutput {ExitCode = Some exitCode} -> Assert.Equal(expectedExitCode, exitCode) + | ExecutionOutput {Outcome = ExitCode exitCode} -> Assert.Equal(expectedExitCode, exitCode) | _ -> failwith "Cannot check exit code on this run result." result let private checkOutputInOrder (category: string) (substrings: string list) (selector: ExecutionOutput -> string) (result: CompilationResult) : CompilationResult = match result.RunOutput with - | None -> failwith (sprintf "Execution output is missing cannot check \"%A\"" category) + | None -> + printfn "Execution output is missing cannot check \"%A\"" category + failwith "Execution output is missing." | Some o -> match o with | ExecutionOutput e -> @@ -1743,9 +1738,11 @@ Actual: let private assertEvalOutput (selector: FsiValue -> 'T) (value: 'T) (result: CompilationResult) : CompilationResult = match result.RunOutput with | None -> failwith "Execution output is missing cannot check value." - | Some (EvalOutput (Ok (Some e))) -> Assert.Equal<'T>(value, (selector e)) - | Some (EvalOutput (Ok None )) -> failwith "Cannot assert value of evaluation, since it is None." - | Some (EvalOutput (Result.Error ex)) -> raise ex + | Some (EvalOutput output) -> + match output.Result with + | Ok (Some e) -> Assert.Equal<'T>(value, (selector e)) + | Ok None -> failwith "Cannot assert value of evaluation, since it is None." + | Result.Error ex -> raise ex | Some _ -> failwith "Only 'eval' output is supported." result @@ -1775,7 +1772,9 @@ Actual: |> Array.filter (fun s -> s.Length > 0) if not (actual |> Array.contains expected) then - failwith ($"The following signature:\n%s{expected}\n\nwas not found in:\n" + (actual |> String.concat "\n")) + printfn $"The following signature:\n%s{expected}\n\nwas not found in:" + actual |> Array.iter (printfn "%s") + failwith "Expected signature was not found." let private printSignaturesImpl pageWidth cUnit = cUnit diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index 37a8e25e164..4fd33216c93 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -2,6 +2,8 @@ namespace FSharp.Test +open System.Threading + #nowarn "57" open System @@ -61,6 +63,16 @@ module AssemblyResolver = do addResolver() #endif +type ExecutionOutcome = + | NoExitCode + | ExitCode of int + | Failure of exn + +type ExecutionOutput = + { Outcome: ExecutionOutcome + StdOut: string + StdErr: string } + [] type ILVerifier (dllFilePath: string) = @@ -295,14 +307,15 @@ and Compilation = | n -> Some n Compilation(sources, output, options, targetFramework, cmplRefs, name, outputDirectory) - -module rec CompilerAssertHelpers = +module TestContext = let UseTransparentCompiler = FSharp.Compiler.CompilerConfig.FSharpExperimentalFeaturesEnabledAutomatically || not (String.IsNullOrWhiteSpace(Environment.GetEnvironmentVariable("TEST_TRANSPARENT_COMPILER"))) - let checker = FSharpChecker.Create(suggestNamesForErrors=true, useTransparentCompiler=UseTransparentCompiler) + let Checker = FSharpChecker.Create(suggestNamesForErrors=true, useTransparentCompiler = UseTransparentCompiler) + +module CompilerAssertHelpers = // Unlike C# whose entrypoint is always string[] F# can make an entrypoint with 0 args, or with an array of string[] let mkDefaultArgs (entryPoint:MethodBase) : obj[] = [| @@ -322,48 +335,64 @@ module rec CompilerAssertHelpers = else entryPoint let args = mkDefaultArgs entryPoint - captureConsoleOutputs (fun () -> entryPoint.Invoke(Unchecked.defaultof, args)) + let outcome = + try + match entryPoint.Invoke(Unchecked.defaultof, args) with + | :? int as rc -> ExitCode rc + | _ -> NoExitCode + with + | exn -> Failure exn + outcome, TestConsole.OutText, TestConsole.ErrorText #if NETCOREAPP - let executeBuiltApp assembly deps isFsx = + let executeBuiltApp assemblyPath deps isFsx = let ctxt = AssemblyLoadContext("ContextName", true) try ctxt.add_Resolving(fun ctxt name -> deps |> List.tryFind (fun (x: string) -> Path.GetFileNameWithoutExtension x = name.Name) |> Option.map ctxt.LoadFromAssemblyPath - |> Option.defaultValue null) + |> Option.toObj) - executeAssemblyEntryPoint (ctxt.LoadFromAssemblyPath assembly) isFsx + executeAssemblyEntryPoint (ctxt.LoadFromAssemblyPath assemblyPath) isFsx finally ctxt.Unload() #else type Worker () = inherit MarshalByRefObject() - member x.ExecuteTestCase assemblyPath (deps: string[]) isFsx = - AppDomain.CurrentDomain.add_AssemblyResolve(ResolveEventHandler(fun _ args -> - deps - |> Array.tryFind (fun (x: string) -> Path.GetFileNameWithoutExtension x = AssemblyName(args.Name).Name) - |> Option.bind (fun x -> if FileSystem.FileExistsShim x then Some x else None) - |> Option.map Assembly.LoadFile - |> Option.defaultValue null)) - + member x.ExecuteTestCase assemblyPath isFsx = + // Set console streams for the AppDomain. + TestConsole.initStreamsCapture() + TestConsole.resetWriters() let assembly = Assembly.LoadFrom assemblyPath executeAssemblyEntryPoint assembly isFsx - let adSetup = - let setup = new System.AppDomainSetup () - let directory = Path.GetDirectoryName(typeof.Assembly.Location) - setup.ApplicationBase <- directory - setup + let executeBuiltApp assembly dependecies isFsx = + let thisAssemblyDirectory = Path.GetDirectoryName(typeof.Assembly.Location) + let setup = AppDomainSetup(ApplicationBase = thisAssemblyDirectory) + let testCaseDomain = AppDomain.CreateDomain($"built app {assembly}", null, setup) + + testCaseDomain.add_AssemblyResolve(fun _ args -> + dependecies + |> List.tryFind (fun path -> Path.GetFileNameWithoutExtension path = AssemblyName(args.Name).Name) + |> Option.filter FileSystem.FileExistsShim + |> Option.map Assembly.LoadFile + |> Option.toObj + ) - let executeBuiltApp assembly deps = - let ad = AppDomain.CreateDomain((Guid()).ToString(), null, adSetup) let worker = - use _ = new AlreadyLoadedAppDomainResolver() - (ad.CreateInstanceFromAndUnwrap(typeof.Assembly.CodeBase, typeof.FullName)) :?> Worker - worker.ExecuteTestCase assembly (deps |> Array.ofList) + (testCaseDomain.CreateInstanceFromAndUnwrap(typeof.Assembly.CodeBase, typeof.FullName)) :?> Worker + + let outcome, output, errors = worker.ExecuteTestCase assembly isFsx + // Replay streams captured in appdomain. + printf $"{output}" + eprintf $"{errors}" + + AppDomain.Unload testCaseDomain + + outcome, output, errors + #endif let defaultProjectOptions (targetFramework: TargetFramework) = @@ -409,31 +438,16 @@ module rec CompilerAssertHelpers = // Generate a response file, purely for diagnostic reasons. File.WriteAllLines(Path.ChangeExtension(outputFilePath, ".rsp"), args) - let errors, ex = checker.Compile args |> Async.RunImmediate + let errors, ex = TestContext.Checker.Compile args |> Async.RunImmediate errors, ex, outputFilePath let compileDisposable (outputDirectory:DirectoryInfo) isExe options targetFramework nameOpt (sources:SourceCodeFileKind list) = - let disposeFile path = - { - new IDisposable with - member _.Dispose() = - try File.Delete path with | _ -> () - } - let disposals = ResizeArray() - let disposeList = - { - new IDisposable with - member _.Dispose() = - for item in disposals do - item.Dispose() - } let name = match nameOpt with | Some name -> name | _ -> getTemporaryFileNameInDirectory outputDirectory.FullName let outputFilePath = Path.ChangeExtension (Path.Combine(outputDirectory.FullName, name), if isExe then ".exe" else ".dll") - disposals.Add(disposeFile outputFilePath) let sources = [ for item in sources do @@ -443,7 +457,6 @@ module rec CompilerAssertHelpers = let source = item.ChangeExtension let destFileName = Path.Combine(outputDirectory.FullName, Path.GetFileName(source.GetSourceFileName)) File.WriteAllText (destFileName, text) - disposals.Add(disposeFile destFileName) yield source.WithFileName(destFileName) | None -> // On Disk file @@ -451,15 +464,9 @@ module rec CompilerAssertHelpers = let source = item.ChangeExtension let destFileName = Path.Combine(outputDirectory.FullName, Path.GetFileName(source.GetSourceFileName)) File.Copy(sourceFileName, destFileName, true) - disposals.Add(disposeFile destFileName) yield source.WithFileName(destFileName) ] - try - disposeList, rawCompile outputFilePath isExe options targetFramework sources - with - | _ -> - disposeList.Dispose() - reraise() + rawCompile outputFilePath isExe options targetFramework sources let assertErrors libAdjust ignoreWarnings (errors: FSharpDiagnostic []) expectedErrors = let errorMessage (error: FSharpDiagnostic) = @@ -520,7 +527,29 @@ module rec CompilerAssertHelpers = finally try Directory.Delete(tempDir, true) with | _ -> () - let rec evaluateReferences (outputPath:DirectoryInfo) (disposals: ResizeArray) ignoreWarnings (cmpl: Compilation) : string[] * string list = + let rec compileCompilationAux outputDirectory ignoreWarnings (cmpl: Compilation) : (FSharpDiagnostic[] * exn option * string) * string list = + + let compilationRefs, deps = evaluateReferences outputDirectory ignoreWarnings cmpl + let isExe, sources, options, targetFramework, name = + match cmpl with + | Compilation(sources, output, options, targetFramework, _, name, _) -> + (match output with | Module -> false | Library -> false | Exe -> true), // isExe + sources, + options, + targetFramework, + name + + let res = compileDisposable outputDirectory isExe (Array.append options compilationRefs) targetFramework name sources + + let deps2 = + compilationRefs + |> Array.filter (fun x -> not (x.Contains("--staticlink"))) + |> Array.map (fun x -> x.Replace("-r:", String.Empty)) + |> List.ofArray + + res, (deps @ deps2) + + and evaluateReferences (outputPath:DirectoryInfo) ignoreWarnings (cmpl: Compilation) : string[] * string list = match cmpl with | Compilation(_, _, _, _, cmpls, _, _) -> let compiledRefs = @@ -528,14 +557,13 @@ module rec CompilerAssertHelpers = |> List.map (fun cmpl -> match cmpl with | CompilationReference (cmpl, staticLink) -> - compileCompilationAux outputPath disposals ignoreWarnings cmpl, staticLink + compileCompilationAux outputPath ignoreWarnings cmpl, staticLink | TestCompilationReference (cmpl) -> let fileName = match cmpl with | TestCompilation.CSharp c when not (String.IsNullOrWhiteSpace c.AssemblyName) -> c.AssemblyName | _ -> getTemporaryFileNameInDirectory outputPath.FullName let tmp = Path.Combine(outputPath.FullName, Path.ChangeExtension(fileName, ".dll")) - disposals.Add({ new IDisposable with member _.Dispose() = File.Delete tmp }) cmpl.EmitAsFile tmp (([||], None, tmp), []), false) @@ -559,38 +587,9 @@ module rec CompilerAssertHelpers = compilationRefs, deps - let compileCompilationAux outputDirectory (disposals: ResizeArray) ignoreWarnings (cmpl: Compilation) : (FSharpDiagnostic[] * exn option * string) * string list = - - let compilationRefs, deps = evaluateReferences outputDirectory disposals ignoreWarnings cmpl - let isExe, sources, options, targetFramework, name = - match cmpl with - | Compilation(sources, output, options, targetFramework, _, name, _) -> - (match output with | Module -> false | Library -> false | Exe -> true), // isExe - sources, - options, - targetFramework, - name - - let disposal, res = compileDisposable outputDirectory isExe (Array.append options compilationRefs) targetFramework name sources - disposals.Add(disposal) - - let deps2 = - compilationRefs - |> Array.filter (fun x -> not (x.Contains("--staticlink"))) - |> Array.map (fun x -> x.Replace("-r:", String.Empty)) - |> List.ofArray - - res, (deps @ deps2) - let compileCompilation ignoreWarnings (cmpl: Compilation) f = - let disposals = ResizeArray() - try - let outputDirectory = DirectoryInfo(createTemporaryDirectory "compileCompilation") - disposals.Add({ new IDisposable with member _.Dispose() = try File.Delete (outputDirectory.FullName) with | _ -> () }) - f (compileCompilationAux outputDirectory disposals ignoreWarnings cmpl) - finally - disposals - |> Seq.iter (fun x -> x.Dispose()) + let outputDirectory = DirectoryInfo(createTemporaryDirectory "compileCompilation") + f (compileCompilationAux outputDirectory ignoreWarnings cmpl) // NOTE: This function will not clean up all the compiled projects after itself. // The reason behind is so we can compose verification of test runs easier. @@ -602,44 +601,11 @@ module rec CompilerAssertHelpers = | Compilation _ -> DirectoryInfo(createTemporaryDirectory "returnCompilation") outputDirectory.Create() - compileCompilationAux outputDirectory (ResizeArray()) ignoreWarnings cmpl - - let captureConsoleOutputs (func: unit -> obj) = - let out = Console.Out - let err = Console.Error - - let stdout = StringBuilder () - let stderr = StringBuilder () + compileCompilationAux outputDirectory ignoreWarnings cmpl - use outWriter = new StringWriter (stdout) - use errWriter = new StringWriter (stderr) + let unwrapException (ex: exn) = ex.InnerException |> Option.ofObj |> Option.map _.Message |> Option.defaultValue ex.Message - let rc, exn = - try - try - Console.SetOut outWriter - Console.SetError errWriter - let rc = func() - match rc with - | :? int as rc -> Some rc, None - | _ -> None, None - with e -> - let errorMessage = if e.InnerException <> null then e.InnerException.ToString() else e.ToString() - stderr.Append errorMessage |> ignore - None, Some e - finally - Console.SetOut out - Console.SetError err - outWriter.Close() - errWriter.Close() - - rc, stdout.ToString(), stderr.ToString(), exn - - let executeBuiltAppAndReturnResult (outputFilePath: string) (deps: string list) isFsx : (int option * string * string * exn option) = - let rc, stdout, stderr, exn = executeBuiltApp outputFilePath deps isFsx - rc, stdout, stderr, exn - - let executeBuiltAppNewProcessAndReturnResult (outputFilePath: string) : (int * string * string) = + let executeBuiltAppNewProcess (outputFilePath: string) = #if !NETCOREAPP let fileName = outputFilePath let arguments = "" @@ -659,13 +625,11 @@ module rec CompilerAssertHelpers = }""" let runtimeconfigPath = Path.ChangeExtension(outputFilePath, ".runtimeconfig.json") File.WriteAllText(runtimeconfigPath, runtimeconfig) - use _disposal = - { new IDisposable with - member _.Dispose() = try File.Delete runtimeconfigPath with | _ -> () } #endif - let timeout = 30000 - let exitCode, output, errors = Commands.executeProcess fileName arguments (Path.GetDirectoryName(outputFilePath)) timeout - (exitCode, output |> String.concat "\n", errors |> String.concat "\n") + let rc, output, errors = Commands.executeProcess fileName arguments (Path.GetDirectoryName(outputFilePath)) + String.Join(Environment.NewLine, output) |> printf "%s" + String.Join(Environment.NewLine, errors) |> eprintf "%s" + ExitCode rc, TestConsole.OutText, TestConsole.ErrorText open CompilerAssertHelpers @@ -678,7 +642,7 @@ type CompilerAssert private () = if errors.Length > 0 then Assert.Fail (sprintf "Compile had warnings and/or errors: %A" errors) - executeBuiltApp outputExe [] false |> ignore + executeBuiltApp outputExe [] false ) static let compileLibraryAndVerifyILWithOptions options (source: SourceCodeFileKind) (f: ILVerifier -> unit) = @@ -691,7 +655,6 @@ type CompilerAssert private () = f (ILVerifier outputFilePath) ) - static let compileLibraryAndVerifyDebugInfoWithOptions options (expectedFile: string) (source: SourceCodeFileKind) = let options = [| yield! options; yield"--test:DumpDebugInfo" |] compile false options source (fun (errors, _, outputFilePath) -> @@ -714,8 +677,6 @@ Updated automatically, please check diffs in your pull request, changes must be """ ) - static member Checker = checker - static member DefaultProjectOptions = defaultProjectOptions static member GenerateFsInputPath() = @@ -740,15 +701,14 @@ Updated automatically, please check diffs in your pull request, changes must be returnCompilation cmpl (defaultArg ignoreWarnings false) static member ExecuteAndReturnResult (outputFilePath: string, isFsx: bool, deps: string list, newProcess: bool) = - if not newProcess then - let entryPointReturnCode, deps, isFsx, exn = executeBuiltAppAndReturnResult outputFilePath deps isFsx - entryPointReturnCode, deps, isFsx, exn - else - let processExitCode, deps, isFsx = executeBuiltAppNewProcessAndReturnResult outputFilePath - Some processExitCode, deps, isFsx, None - + let outcome, output, errors = + if not newProcess then + executeBuiltApp outputFilePath deps isFsx + else + executeBuiltAppNewProcess outputFilePath + { Outcome = outcome; StdOut = output; StdErr = errors} - static member Execute(cmpl: Compilation, ?ignoreWarnings, ?beforeExecute, ?newProcess, ?onOutput) = + static member Execute(cmpl: Compilation, ?ignoreWarnings, ?beforeExecute, ?newProcess) = let copyDependenciesToOutputDir (outputFilePath:string) (deps: string list) = let outputDirectory = Path.GetDirectoryName(outputFilePath) @@ -760,24 +720,27 @@ Updated automatically, please check diffs in your pull request, changes must be let ignoreWarnings = defaultArg ignoreWarnings false let beforeExecute = defaultArg beforeExecute copyDependenciesToOutputDir let newProcess = defaultArg newProcess false - let onOutput = defaultArg onOutput (fun _ -> ()) compileCompilation ignoreWarnings cmpl (fun ((errors, _, outputFilePath), deps) -> assertErrors 0 ignoreWarnings errors [||] beforeExecute outputFilePath deps - if newProcess then - let (exitCode, output, errors) = executeBuiltAppNewProcessAndReturnResult outputFilePath - if exitCode <> 0 then - Assert.Fail errors - onOutput output - else - let _rc, _stdout, _stderr, exn = executeBuiltApp outputFilePath deps false - exn |> Option.iter raise) + let outcome, _, _ = + if newProcess then + executeBuiltAppNewProcess outputFilePath + else + executeBuiltApp outputFilePath deps false + + match outcome with + | ExitCode n when n <> 0 -> failwith $"Process exited with code {n}." + | Failure exn -> raise exn + | _ -> () + ) static member ExecutionHasOutput(cmpl: Compilation, expectedOutput: string) = - CompilerAssert.Execute(cmpl, newProcess = true, onOutput = (fun output -> Assert.Equal(expectedOutput, output))) + CompilerAssert.Execute(cmpl, newProcess = true) + Assert.Equal(expectedOutput, TestConsole.OutText) static member Pass (source: string) = - let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions TargetFramework.Current) |> Async.RunImmediate + let parseResults, fileAnswer = TestContext.Checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions TargetFramework.Current) |> Async.RunImmediate Assert.Empty(parseResults.Diagnostics) @@ -791,7 +754,7 @@ Updated automatically, please check diffs in your pull request, changes must be let defaultOptions = defaultProjectOptions TargetFramework.Current let options = { defaultOptions with OtherOptions = Array.append options defaultOptions.OtherOptions} - let parseResults, fileAnswer = checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, options) |> Async.RunImmediate + let parseResults, fileAnswer = TestContext.Checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, options) |> Async.RunImmediate Assert.Empty(parseResults.Diagnostics) @@ -805,7 +768,7 @@ Updated automatically, please check diffs in your pull request, changes must be let absoluteSourceFile = System.IO.Path.Combine(sourceDirectory, sourceFile) let parseResults, fileAnswer = let defaultOptions = defaultProjectOptions TargetFramework.Current - checker.ParseAndCheckFileInProject( + TestContext.Checker.ParseAndCheckFileInProject( sourceFile, 0, SourceText.ofString (File.ReadAllText absoluteSourceFile), @@ -836,7 +799,7 @@ Updated automatically, please check diffs in your pull request, changes must be let errors = let parseResults, fileAnswer = let defaultOptions = defaultProjectOptions TargetFramework.Current - checker.ParseAndCheckFileInProject( + TestContext.Checker.ParseAndCheckFileInProject( name, 0, SourceText.ofString source, @@ -862,7 +825,7 @@ Updated automatically, please check diffs in your pull request, changes must be let errors = let parseResults, fileAnswer = let defaultOptions = defaultProjectOptions TargetFramework.Current - checker.ParseAndCheckFileInProject( + TestContext.Checker.ParseAndCheckFileInProject( "test.fs", 0, SourceText.ofString source, @@ -883,7 +846,7 @@ Updated automatically, please check diffs in your pull request, changes must be static member ParseAndTypeCheck(options, name, source: string) = let parseResults, fileAnswer = let defaultOptions = defaultProjectOptionsForFilePath name TargetFramework.Current - checker.ParseAndCheckFileInProject( + TestContext.Checker.ParseAndCheckFileInProject( name, 0, SourceText.ofString source, @@ -906,7 +869,7 @@ Updated automatically, please check diffs in your pull request, changes must be let errors = let parseResults, fileAnswer = let defaultOptions = defaultProjectOptions TargetFramework.Current - checker.ParseAndCheckFileInProject( + TestContext.Checker.ParseAndCheckFileInProject( "test.fs", 0, SourceText.ofString source, @@ -954,7 +917,7 @@ Updated automatically, please check diffs in your pull request, changes must be } )) - let snapshot = FSharpProjectSnapshot.FromOptions(projectOptions, getFileSnapshot) |> Async.RunSynchronously + let snapshot = FSharpProjectSnapshot.FromOptions(projectOptions, getFileSnapshot) |> Async.RunImmediate checker.ParseAndCheckProject(snapshot) else @@ -1038,10 +1001,10 @@ Updated automatically, please check diffs in your pull request, changes must be | Choice2Of2 ex -> errorMessages.Add(ex.Message) | _ -> () - errorMessages, outStream.ToString() + errorMessages, string outStream, string errStream static member RunScriptWithOptions options (source: string) (expectedErrorMessages: string list) = - let errorMessages, _ = CompilerAssert.RunScriptWithOptionsAndReturnResult options source + let errorMessages, _, _ = CompilerAssert.RunScriptWithOptionsAndReturnResult options source if expectedErrorMessages.Length <> errorMessages.Count then Assert.Fail(sprintf "Expected error messages: %A \n\n Actual error messages: %A" expectedErrorMessages errorMessages) else @@ -1060,7 +1023,7 @@ Updated automatically, please check diffs in your pull request, changes must be { FSharpParsingOptions.Default with SourceFiles = [| sourceFileName |] LangVersionText = langVersion } - checker.ParseFile(sourceFileName, SourceText.ofString source, parsingOptions) |> Async.RunImmediate + TestContext.Checker.ParseFile(sourceFileName, SourceText.ofString source, parsingOptions) |> Async.RunImmediate static member ParseWithErrors (source: string, ?langVersion: string) = fun expectedParseErrors -> let parseResults = CompilerAssert.Parse (source, ?langVersion=langVersion) diff --git a/tests/FSharp.Test.Utilities/DirectoryAttribute.fs b/tests/FSharp.Test.Utilities/DirectoryAttribute.fs index c1561fa6c9b..1266bc295a8 100644 --- a/tests/FSharp.Test.Utilities/DirectoryAttribute.fs +++ b/tests/FSharp.Test.Utilities/DirectoryAttribute.fs @@ -9,6 +9,7 @@ open Xunit.Sdk open FSharp.Compiler.IO open FSharp.Test.Compiler open FSharp.Test.Utilities +open TestFramework /// Attribute to use with Xunit's TheoryAttribute. /// Takes a directory, relative to current test suite's root. @@ -22,7 +23,6 @@ type DirectoryAttribute(dir: string) = invalidArg "dir" "Directory cannot be null, empty or whitespace only." let dirInfo = normalizePathSeparator (Path.GetFullPath(dir)) - let outputDirectory methodName extraDirectory = getTestOutputDirectory dir methodName extraDirectory let mutable baselineSuffix = "" let mutable includes = Array.empty @@ -31,19 +31,8 @@ type DirectoryAttribute(dir: string) = | true -> Some (File.ReadAllText path) | _ -> None - let createCompilationUnit path (filename: string) methodName multipleFiles = - // if there are multiple files being processed, add extra directory for each test to avoid reference file conflicts - let extraDirectory = - if multipleFiles then - let extension = Path.GetExtension(filename) - filename.Substring(0, filename.Length - extension.Length) // remove .fs/the extension - |> normalizeName - else "" - let outputDirectory = outputDirectory methodName extraDirectory - let outputDirectoryPath = - match outputDirectory with - | Some path -> path.FullName - | None -> failwith "Can't set the output directory" + let createCompilationUnit path (filename: string) = + let outputDirectoryPath = createTemporaryDirectory "dir" let sourceFilePath = normalizePathSeparator (path ++ filename) let fsBslFilePath = sourceFilePath + baselineSuffix + ".err.bsl" let ilBslFilePath = @@ -97,7 +86,7 @@ type DirectoryAttribute(dir: string) = Name = Some filename IgnoreWarnings = false References = [] - OutputDirectory = outputDirectory + OutputDirectory = Some (DirectoryInfo(outputDirectoryPath)) TargetFramework = TargetFramework.Current StaticLink = false } |> FS @@ -107,7 +96,7 @@ type DirectoryAttribute(dir: string) = member _.BaselineSuffix with get() = baselineSuffix and set v = baselineSuffix <- v member _.Includes with get() = includes and set v = includes <- v - override _.GetData(method: MethodInfo) = + override _.GetData _ = if not (Directory.Exists(dirInfo)) then failwith (sprintf "Directory does not exist: \"%s\"." dirInfo) @@ -127,8 +116,6 @@ type DirectoryAttribute(dir: string) = if not <| FileSystem.FileExistsShim(f) then failwithf "Requested file \"%s\" not found.\nAll files: %A.\nIncludes:%A." f allFiles includes - let multipleFiles = fsFiles |> Array.length > 1 - fsFiles - |> Array.map (fun fs -> createCompilationUnit dirInfo fs method.Name multipleFiles) + |> Array.map (fun fs -> createCompilationUnit dirInfo fs) |> Seq.map (fun c -> [| c |]) diff --git a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj index 7ccc5306751..5ec38117917 100644 --- a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj +++ b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj @@ -10,6 +10,7 @@ true false false + false $(OtherFlags) --warnon:1182 true @@ -28,6 +29,7 @@ scriptlib.fsx + @@ -42,6 +44,10 @@ + + + + @@ -58,6 +64,9 @@ + + + @@ -99,7 +108,7 @@ - + diff --git a/tests/FSharp.Test.Utilities/ILChecker.fs b/tests/FSharp.Test.Utilities/ILChecker.fs index de0fbd8050b..b47ae4409f0 100644 --- a/tests/FSharp.Test.Utilities/ILChecker.fs +++ b/tests/FSharp.Test.Utilities/ILChecker.fs @@ -15,8 +15,7 @@ module ILChecker = let private exec exe args = let arguments = args |> String.concat " " - let timeout = 30000 - let exitCode, _output, errors = Commands.executeProcess exe arguments "" timeout + let exitCode, _output, errors = Commands.executeProcess exe arguments "" let errors = errors |> String.concat Environment.NewLine errors, exitCode diff --git a/tests/FSharp.Test.Utilities/Peverifier.fs b/tests/FSharp.Test.Utilities/Peverifier.fs index f3ccc7de2b1..0591a435484 100644 --- a/tests/FSharp.Test.Utilities/Peverifier.fs +++ b/tests/FSharp.Test.Utilities/Peverifier.fs @@ -24,8 +24,7 @@ module PEVerifier = let private exec exe args = let arguments = args |> String.concat " " - let timeout = 30000 - let exitCode, _output, errors = Commands.executeProcess exe arguments "" timeout + let exitCode, _output, errors = Commands.executeProcess exe arguments "" let errors = errors |> String.concat Environment.NewLine errors, exitCode diff --git a/tests/FSharp.Test.Utilities/ProjectGeneration.fs b/tests/FSharp.Test.Utilities/ProjectGeneration.fs index a75784240dd..0dd94d35236 100644 --- a/tests/FSharp.Test.Utilities/ProjectGeneration.fs +++ b/tests/FSharp.Test.Utilities/ProjectGeneration.fs @@ -31,6 +31,8 @@ open FSharp.Compiler.Text open Xunit +open FSharp.Test.Utilities + open OpenTelemetry open OpenTelemetry.Resources open OpenTelemetry.Trace @@ -224,9 +226,7 @@ let sourceFile fileId deps = IsPhysicalFile = false } -let OptionsCache = ConcurrentDictionary() - - +let OptionsCache = ConcurrentDictionary<_, FSharpProjectOptions>() type SyntheticProject = @@ -295,7 +295,7 @@ type SyntheticProject = member this.GetProjectOptions(checker: FSharpChecker) = - let cacheKey = + let key = this.GetAllFiles() |> List.collect (fun (p, f) -> [ p.Name @@ -305,53 +305,55 @@ type SyntheticProject = this.FrameworkReferences, this.NugetReferences - if not (OptionsCache.ContainsKey cacheKey) then - OptionsCache[cacheKey] <- - use _ = Activity.start "SyntheticProject.GetProjectOptions" [ "project", this.Name ] + let factory _ = + use _ = Activity.start "SyntheticProject.GetProjectOptions" [ "project", this.Name ] - let referenceScript = - seq { - yield! this.FrameworkReferences |> Seq.map getFrameworkReference + let referenceScript = + seq { + yield! this.FrameworkReferences |> Seq.map getFrameworkReference + if not this.NugetReferences.IsEmpty then this.NugetReferences |> getNugetReferences (Some "https://api.nuget.org/v3/index.json") - } - |> String.concat "\n" - - let baseOptions, _ = - checker.GetProjectOptionsFromScript( - "file.fsx", - SourceText.ofString referenceScript, - assumeDotNetFramework = false - ) - |> Async.RunSynchronously - - { - ProjectFileName = this.ProjectFileName - ProjectId = None - SourceFiles = - [| for f in this.SourceFiles do - if f.HasSignatureFile then - this.ProjectDir ++ f.SignatureFileName - - this.ProjectDir ++ f.FileName |] - OtherOptions = - Set [ - yield! baseOptions.OtherOptions - "--optimize+" - for p in this.DependsOn do - $"-r:{p.OutputFilename}" - yield! this.OtherOptions ] - |> Set.toArray - ReferencedProjects = - [| for p in this.DependsOn do - FSharpReferencedProject.FSharpReference(p.OutputFilename, p.GetProjectOptions checker) |] - IsIncompleteTypeCheckEnvironment = false - UseScriptResolutionRules = this.UseScriptResolutionRules - LoadTime = DateTime() - UnresolvedReferences = None - OriginalLoadReferences = [] - Stamp = None } - - OptionsCache[cacheKey] + } + |> String.concat "\n" + + let baseOptions, _ = + checker.GetProjectOptionsFromScript( + "file.fsx", + SourceText.ofString referenceScript, + assumeDotNetFramework = false + ) + |> Async.RunImmediate + + { + ProjectFileName = this.ProjectFileName + ProjectId = None + SourceFiles = + [| for f in this.SourceFiles do + if f.HasSignatureFile then + this.ProjectDir ++ f.SignatureFileName + + this.ProjectDir ++ f.FileName |] + OtherOptions = + Set [ + yield! baseOptions.OtherOptions + "--optimize+" + for p in this.DependsOn do + $"-r:{p.OutputFilename}" + yield! this.OtherOptions ] + |> Set.toArray + ReferencedProjects = + [| for p in this.DependsOn do + FSharpReferencedProject.FSharpReference(p.OutputFilename, p.GetProjectOptions checker) |] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = this.UseScriptResolutionRules + LoadTime = DateTime() + UnresolvedReferences = None + OriginalLoadReferences = [] + Stamp = None } + + + OptionsCache.GetOrAdd(key, factory) + member this.GetAllProjects() = [ this @@ -951,7 +953,7 @@ type ProjectWorkflowBuilder ?enablePartialTypeChecking ) = - let useTransparentCompiler = defaultArg useTransparentCompiler CompilerAssertHelpers.UseTransparentCompiler + let useTransparentCompiler = defaultArg useTransparentCompiler TestContext.UseTransparentCompiler let useGetSource = not useTransparentCompiler && defaultArg useGetSource false let useChangeNotifications = not useTransparentCompiler && defaultArg useChangeNotifications false let autoStart = defaultArg autoStart true @@ -1027,11 +1029,12 @@ type ProjectWorkflowBuilder member this.Execute(workflow: Async) = try - Async.RunSynchronously(workflow, timeout = defaultArg runTimeout 600_000) + // We don't want the defaultCancellationToken. + Async.RunSynchronously(workflow, cancellationToken = Threading.CancellationToken.None, ?timeout = runTimeout) finally if initialContext.IsNone && not isExistingProject then this.DeleteProjectDir() - activity |> Option.iter (fun x -> x.Dispose()) + activity |> Option.iter (fun x -> if not (isNull x) then x.Dispose()) tracerProvider |> Option.iter (fun x -> x.ForceFlush() |> ignore x.Dispose()) @@ -1135,14 +1138,10 @@ type ProjectWorkflowBuilder async { let! ctx = workflow - use activity = - Activity.start "ProjectWorkflowBuilder.CheckFile" [ Activity.Tags.project, initialProject.Name; "fileId", fileId ] - let! results = + use _ = Activity.start "ProjectWorkflowBuilder.CheckFile" [ Activity.Tags.project, initialProject.Name; "fileId", fileId ] checkFile fileId ctx.Project checker - activity.Dispose() - let oldSignature = ctx.Signatures[fileId] let newSignature = getSignature results diff --git a/tests/FSharp.Test.Utilities/ScriptHelpers.fs b/tests/FSharp.Test.Utilities/ScriptHelpers.fs index 688941934c9..238755c0eaa 100644 --- a/tests/FSharp.Test.Utilities/ScriptHelpers.fs +++ b/tests/FSharp.Test.Utilities/ScriptHelpers.fs @@ -41,10 +41,14 @@ type private EventedTextWriter() = sw.WriteLine line lineWritten.Trigger(line) else sb.Append(c) |> ignore - override _.ToString() = sw.ToString() + override _.ToString() = + sw.Flush() + sw.ToString() type FSharpScript(?additionalArgs: string[], ?quiet: bool, ?langVersion: LangVersion, ?input: string) = + do ignore input + let additionalArgs = defaultArg additionalArgs [||] let quiet = defaultArg quiet true let langVersion = defaultArg langVersion LangVersion.Preview @@ -71,19 +75,11 @@ type FSharpScript(?additionalArgs: string[], ?quiet: bool, ?langVersion: LangVer |] let argv = Array.append baseArgs additionalArgs - - let inReader = new StringReader(defaultArg input "") + let outWriter = new EventedTextWriter() let errorWriter = new EventedTextWriter() - let previousIn, previousOut, previousError = Console.In, Console.Out, Console.Error - - do - Console.SetIn inReader - Console.SetOut outWriter - Console.SetError errorWriter - - let fsi = FsiEvaluationSession.Create (config, argv, stdin, stdout, stderr) + let fsi = FsiEvaluationSession.Create (config, argv, stdin, TextWriter.Synchronized outWriter, TextWriter.Synchronized errorWriter) member _.ValueBound = fsi.ValueBound @@ -103,6 +99,9 @@ type FSharpScript(?additionalArgs: string[], ?quiet: bool, ?langVersion: LangVer let cancellationToken = defaultArg cancellationToken CancellationToken.None let ch, errors = fsi.EvalInteractionNonThrowing(code, cancellationToken) + // Replay output to test console. + printf $"{this.GetOutput()}" + eprintf $"{this.GetErrorOutput()}" Thread.CurrentThread.CurrentCulture <- originalCulture @@ -127,9 +126,6 @@ type FSharpScript(?additionalArgs: string[], ?quiet: bool, ?langVersion: LangVer interface IDisposable with member this.Dispose() = ((this.Fsi) :> IDisposable).Dispose() - Console.SetIn previousIn - Console.SetOut previousOut - Console.SetError previousError [] module TestHelpers = diff --git a/tests/FSharp.Test.Utilities/ScriptingShims.fsx b/tests/FSharp.Test.Utilities/ScriptingShims.fsx index 392d2b002b6..be9ce9142c5 100644 --- a/tests/FSharp.Test.Utilities/ScriptingShims.fsx +++ b/tests/FSharp.Test.Utilities/ScriptingShims.fsx @@ -2,13 +2,7 @@ namespace global [] module GlobalShims = - - let errorStringWriter = new System.IO.StringWriter() - let oldConsoleError = System.Console.Error - do System.Console.SetError(errorStringWriter) - let exit (code:int) = - System.Console.SetError(oldConsoleError) - if code=0 then + if code = 0 then () - else failwith $"Script called function 'exit' with code={code} and collected in stderr: {errorStringWriter.ToString()}" \ No newline at end of file + else failwith $"Script called function 'exit' with code={code}." diff --git a/tests/FSharp.Test.Utilities/TestFramework.fs b/tests/FSharp.Test.Utilities/TestFramework.fs index dfde63f2352..0999e38caef 100644 --- a/tests/FSharp.Test.Utilities/TestFramework.fs +++ b/tests/FSharp.Test.Utilities/TestFramework.fs @@ -4,22 +4,23 @@ module TestFramework open System open System.IO -open System.Reflection open System.Diagnostics +open System.Reflection open Scripting open Xunit open FSharp.Compiler.IO -open Xunit.Sdk +open FSharp.Test let getShortId() = Guid.NewGuid().ToString().[..7] // Temporary directory is TempPath + "/FSharp.Test.Utilities/yyy-MM-dd-xxxxxxx/" let tempDirectoryOfThisTestRun = - let tempDir = Path.GetTempPath() + let temp = Path.GetTempPath() let today = DateTime.Now.ToString("yyyy-MM-dd") - DirectoryInfo(tempDir) - .CreateSubdirectory($"FSharp.Test.Utilities/{today}-{getShortId()}") - .FullName + let directory = + DirectoryInfo(temp).CreateSubdirectory($"FSharp.Test.Utilities/{today}-{getShortId()}") + + directory.FullName let createTemporaryDirectory (part: string) = DirectoryInfo(tempDirectoryOfThisTestRun) @@ -62,7 +63,7 @@ module Commands = // Execute the process pathToExe passing the arguments: arguments with the working directory: workingDir timeout after timeout milliseconds -1 = wait forever // returns exit code, stdio and stderr as string arrays - let executeProcess pathToExe arguments workingDir (timeout:int) = + let executeProcess pathToExe arguments workingDir = let commandLine = ResizeArray() let errorsList = ResizeArray() let outputList = ResizeArray() @@ -101,11 +102,7 @@ module Commands = if p.Start() then p.BeginOutputReadLine() p.BeginErrorReadLine() - if not(p.WaitForExit(timeout)) then - // Timed out resolving throw a diagnostic. - raise (new TimeoutException(sprintf "Timeout executing command '%s' '%s'" (psi.FileName) (psi.Arguments))) - else - p.WaitForExit() + p.WaitForExit() #if DEBUG let workingDir' = if workingDir = "" @@ -425,13 +422,12 @@ let logConfig (cfg: TestConfig) = log "PEVERIFY = %s" cfg.PEVERIFY log "---------------------------------------------------------------" -let checkOutputPassed (output: string) = - Assert.True(output.Contains "TEST PASSED OK", $"Output does not contain 'TEST PASSED OK':\n{output}") - +let outputPassed (output: string) = output.Contains "TEST PASSED OK" + let checkResultPassed result = match result with | CmdResult.ErrorLevel (msg1, err) -> Assert.Fail (sprintf "%s. ERRORLEVEL %d" msg1 err) - | CmdResult.Success output -> checkOutputPassed output + | CmdResult.Success output -> Assert.True(outputPassed output, "Output does not contain 'TEST PASSED OK'") let checkResult result = match result with @@ -542,7 +538,7 @@ module Command = | :? System.IO.IOException -> //input closed is ok if process is closed () } - sources |> pipeFile |> Async.RunSynchronously + Async.RunSynchronously(sources |> pipeFile, cancellationToken = Threading.CancellationToken.None) let inF fCont cmdArgs = match redirect.Input with @@ -566,8 +562,7 @@ module Command = | Output r -> use writer = openWrite r use outFile = redirectTo writer - use toLog = redirectToLog () - fCont { cmdArgs with RedirectOutput = Some (outFile.Post); RedirectError = Some (toLog.Post) } + fCont { cmdArgs with RedirectOutput = Some (outFile.Post); RedirectError = Some ignore } | OutputAndError (r1,r2) -> use writer1 = openWrite r1 use writer2 = openWrite r2 @@ -581,8 +576,7 @@ module Command = | Error r -> use writer = openWrite r use outFile = redirectTo writer - use toLog = redirectToLog () - fCont { cmdArgs with RedirectOutput = Some (toLog.Post); RedirectError = Some (outFile.Post) } + fCont { cmdArgs with RedirectOutput = Some ignore; RedirectError = Some (outFile.Post) } let exec cmdArgs = log "%s" (logExec dir path args redirect) diff --git a/tests/FSharp.Test.Utilities/Utilities.fs b/tests/FSharp.Test.Utilities/Utilities.fs index 1a6d0ff60f8..52400af3017 100644 --- a/tests/FSharp.Test.Utilities/Utilities.fs +++ b/tests/FSharp.Test.Utilities/Utilities.fs @@ -18,6 +18,7 @@ open System.Collections.Generic open FSharp.Compiler.CodeAnalysis open Newtonsoft.Json open Newtonsoft.Json.Linq +open Xunit.Sdk type TheoryForNETCOREAPPAttribute() = @@ -40,25 +41,10 @@ type FactForDESKTOPAttribute() = // This file mimics how Roslyn handles their compilation references for compilation testing module Utilities = - type RedirectConsole() = - let oldStdOut = Console.Out - let oldStdErr = Console.Error - let newStdOut = new StringWriter() - let newStdErr = new StringWriter() - do Console.SetOut(newStdOut) - do Console.SetError(newStdErr) - member _.Output () = string newStdOut - - member _.ErrorOutput () =string newStdErr - - interface IDisposable with - member _.Dispose() = - Console.SetOut(oldStdOut) - Console.SetError(oldStdErr) type Async with static member RunImmediate (computation: Async<'T>, ?cancellationToken ) = - let cancellationToken = defaultArg cancellationToken Async.DefaultCancellationToken + let cancellationToken = defaultArg cancellationToken CancellationToken.None let ts = TaskCompletionSource<'T>() let task = ts.Task Async.StartWithContinuations( @@ -69,20 +55,6 @@ module Utilities = cancellationToken) task.Result - /// Disposable type to implement a simple resolve handler that searches the currently loaded assemblies to see if the requested assembly is already loaded. - type AlreadyLoadedAppDomainResolver () = - let resolveHandler = - ResolveEventHandler(fun _ args -> - let assemblies = AppDomain.CurrentDomain.GetAssemblies() - let assembly = assemblies |> Array.tryFind(fun a -> String.Compare(a.FullName, args.Name,StringComparison.OrdinalIgnoreCase) = 0) - assembly |> Option.defaultValue Unchecked.defaultof - ) - do AppDomain.CurrentDomain.add_AssemblyResolve(resolveHandler) - - interface IDisposable with - member this.Dispose() = AppDomain.CurrentDomain.remove_AssemblyResolve(resolveHandler) - - [] type TargetFramework = | NetStandard20 @@ -244,8 +216,7 @@ let main argv = 0""" File.WriteAllText(directoryBuildPropsFileName, directoryBuildProps) File.WriteAllText(directoryBuildTargetsFileName, directoryBuildTargets) - let timeout = 120000 - let exitCode, dotnetoutput, dotneterrors = Commands.executeProcess config.DotNetExe "build" projectDirectory timeout + let exitCode, dotnetoutput, dotneterrors = Commands.executeProcess config.DotNetExe "build" projectDirectory if exitCode <> 0 || errors.Length > 0 then errors <- dotneterrors diff --git a/tests/FSharp.Test.Utilities/XunitHelpers.fs b/tests/FSharp.Test.Utilities/XunitHelpers.fs new file mode 100644 index 00000000000..ad9be928254 --- /dev/null +++ b/tests/FSharp.Test.Utilities/XunitHelpers.fs @@ -0,0 +1,222 @@ +#nowarn "0044" +namespace FSharp.Test + +open System +open System.IO +open System.Text +open System.Threading + +open Xunit.Sdk +open Xunit.Abstractions + +module internal TestConsole = + /// Redirects reads performed on different async execution contexts to the relevant TextReader held by AsyncLocal. + type RedirectingTextReader(initial: TextReader) = + inherit TextReader() + let holder = AsyncLocal<_>() + do holder.Value <- initial + + override _.Peek() = holder.Value.Peek() + override _.Read() = holder.Value.Read() + member _.Set (reader: TextReader) = holder.Value <- reader + + /// Redirects writes performed on different async execution contexts to the relevant TextWriter held by AsyncLocal. + type RedirectingTextWriter(initial: TextWriter) = + inherit TextWriter() + let holder = AsyncLocal<_>() + do holder.Value <- initial + + override _.Encoding = Encoding.UTF8 + override _.Write(value: char) = holder.Value.Write(value) + override _.Write(value: string) = holder.Value.Write(value) + override _.WriteLine(value: string) = holder.Value.WriteLine(value) + member _.Value = holder.Value + member _.Set (writer: TextWriter) = holder.Value <- writer + + let localIn = new RedirectingTextReader(TextReader.Null) + let localOut = new RedirectingTextWriter(TextWriter.Null) + let localError = new RedirectingTextWriter(TextWriter.Null) + + let initStreamsCapture () = + Console.SetIn localIn + Console.SetOut localOut + Console.SetError localError + + let resetWriters() = + new StringWriter() |> localOut.Set + new StringWriter() |> localError.Set + +type TestConsole = + static member OutText = + Console.Out.Flush() + string TestConsole.localOut.Value + + static member ErrorText = + Console.Error.Flush() + string TestConsole.localError.Value + + +// To use xUnit means to customize it. The following abomination adds 3 features: +// - Capturing console output individually and in parallel for each test +// - Internally parallelize test classes and theories. Test cases and theory cases included in a single class or F# module can execute simultaneously +// - Add some autogenerated traits for filtering tests + +/// Passes captured console output to xUnit. +type ConsoleCapturingTestRunner(test, messageBus, testClass, constructorArguments, testMethod, testMethodArguments, skipReason, beforeAfterAttributes, aggregator, cancellationTokenSource) = + inherit XunitTestRunner(test, messageBus, testClass, constructorArguments, testMethod, testMethodArguments, skipReason, beforeAfterAttributes, aggregator, cancellationTokenSource) + + member _.BaseInvokeTestMethodAsync aggregator = base.InvokeTestMethodAsync aggregator + override this.InvokeTestAsync (aggregator: ExceptionAggregator): Tasks.Task = + task { + TestConsole.resetWriters() + let! executionTime = this.BaseInvokeTestMethodAsync aggregator + let output = + seq { + TestConsole.OutText + if not (String.IsNullOrEmpty TestConsole.ErrorText) then + "" + "=========== Standard Error ===========" + "" + TestConsole.ErrorText + } |> String.concat Environment.NewLine + return executionTime, output + } + +/// Disables custom internal parallelization. +/// Execute test cases in a class or a module one by one instead of all at once. Allow other collections to run simultaneously. +[] +type RunInSequenceAttribute() = inherit Attribute() + +module TestCaseCustomizations = + // Internally parallelize test classes and theories. + // Based on https://www.meziantou.net/parallelize-test-cases-execution-in-xunit.htm + // The trick is to assign a unique test collection to each case. + // Since test collection is xUnit's unit of parallelization, it will execute everything in parallel including theory cases. + let rewriteTestMethod (testCase: ITestCase) : ITestMethod = + let canFullyParallelize = + // does not belong to a defined collection + isNull testCase.TestMethod.TestClass.TestCollection.CollectionDefinition + && testCase.TestMethod.TestClass.Class.GetCustomAttributes(typeof) |> Seq.isEmpty + // is not marked with `[]` attribute + && testCase.TestMethod.Method.GetCustomAttributes(typeof) |> Seq.isEmpty + && testCase.TestMethod.TestClass.Class.GetCustomAttributes(typeof) |> Seq.isEmpty + + if canFullyParallelize then + let oldTestMethod = testCase.TestMethod + let oldTestClass = oldTestMethod.TestClass + let oldTestCollection = oldTestMethod.TestClass.TestCollection + + // Create a new collection with a unique id for the test case. + let newTestCollection = + new TestCollection( + oldTestCollection.TestAssembly, + oldTestCollection.CollectionDefinition, + oldTestCollection.DisplayName, + Guid.NewGuid() + ) + + let newTestClass = new TestClass(newTestCollection, oldTestClass.Class) + TestMethod(newTestClass, oldTestMethod.Method) + else + testCase.TestMethod + + let addTraits (testCase: ITestCase) = + // Proof of concept. + // Distribute test cases reasonably evenly among number of execution nodes. + // This might be helpful when running tests with parallel multi-agent strategy in CI. + // SHA256 is probably overkill, but the assignment must be stable between test discoveries. + let hashAlgorithm = Security.Cryptography.SHA256.Create() + let assignNode numberOfBuckets = + let bytes = hashAlgorithm.ComputeHash(Encoding.UTF8.GetBytes(testCase.UniqueID)) + let stableHashValue = BitConverter.ToUInt32(bytes, 0) + stableHashValue % uint numberOfBuckets + 1u |> string + + // Add `Project` trait so a project can be selected or filtered out during a full solution test run. Example: --filter Project=FSharp.Compiler.ComponentTests + testCase.Traits["Project"] <- ResizeArray [ testCase.TestMethod.TestClass.TestCollection.TestAssembly.Assembly.Name.Split(',')[0] ] + // Assign test case to one of buckets numbered 1 .. 4 to easily distribute execution among many agents in CI. Example: --filter ExecutionNode=4 + // Number of nodes hardcoded as 4 here could eventually come from an env variable set by the CI. + testCase.Traits["ExecutionNode"] <- ResizeArray [ assignNode 4 ] + +type CustomTestCase = + inherit XunitTestCase + // xUinit demands this constructor for deserialization. + new() = { inherit XunitTestCase() } + + new(sink: IMessageSink, md, mdo, testMethod, testMethodArgs) = { inherit XunitTestCase(sink, md, mdo, testMethod, testMethodArgs) } + + override testCase.RunAsync (_, bus, args, aggregator, cts) = + let runner : XunitTestCaseRunner = + { new XunitTestCaseRunner(testCase, testCase.DisplayName, testCase.SkipReason, args, testCase.TestMethodArguments, bus, aggregator, cts) with + override this.CreateTestRunner(test, bus, testCase, args, testMethod, methodArgs, skipReason, attrs, aggregator, cts) = + ConsoleCapturingTestRunner(test, bus, testCase, args, testMethod, methodArgs, skipReason, attrs, aggregator, cts) + } + runner.RunAsync() + + // Initialize is ensured by xUnit to run once before any property access. + override testCase.Initialize () = + base.Initialize() + testCase.TestMethod <- TestCaseCustomizations.rewriteTestMethod testCase + TestCaseCustomizations.addTraits testCase + +type CustomTheoryTestCase = + inherit XunitTheoryTestCase + new() = { inherit XunitTheoryTestCase() } + + new(sink: IMessageSink, md, mdo, testMethod) = { inherit XunitTheoryTestCase(sink, md, mdo, testMethod) } + + override testCase.RunAsync (sink, bus, args, aggregator, cts) = + let runner : XunitTestCaseRunner = + { new XunitTheoryTestCaseRunner(testCase, testCase.DisplayName, testCase.SkipReason, args, sink, bus, aggregator, cts) with + override this.CreateTestRunner(test, bus, testCase, args, testMethod, methodArgs, skipReason, attrs, aggregator, cts) = + ConsoleCapturingTestRunner(test, bus, testCase, args, testMethod, methodArgs, skipReason, attrs, aggregator, cts) + } + runner.RunAsync() + + override testCase.Initialize () = + base.Initialize() + testCase.TestMethod <- TestCaseCustomizations.rewriteTestMethod testCase + TestCaseCustomizations.addTraits testCase + +/// Customized test framework providing console support and better parallelization for F# tests. +type TestRun(sink: IMessageSink) = + inherit XunitTestFramework(sink) + do + // Init statics + MessageSink.sinkWriter |> ignore + TestConsole.initStreamsCapture() + + override this.CreateDiscoverer (assemblyInfo) = + { new XunitTestFrameworkDiscoverer(assemblyInfo, this.SourceInformationProvider, this.DiagnosticMessageSink) with + override _.FindTestsForType (testClass, includeSourceInformation, messageBus, options) = + // Intercepts test discovery messages to augment test cases with additional capabilities. + let customizingBus = + { new IMessageBus with + member _.QueueMessage (message: IMessageSinkMessage) = + match message with + | :? ITestCaseDiscoveryMessage as discoveryMessage -> + let customized: ITestCase = + match discoveryMessage.TestCase with + | :? XunitTheoryTestCase -> + new CustomTheoryTestCase( + sink, + options.MethodDisplayOrDefault(), + options.MethodDisplayOptionsOrDefault(), + discoveryMessage.TestCase.TestMethod, + SourceInformation = discoveryMessage.TestCase.SourceInformation + ) + | :? XunitTestCase -> + new CustomTestCase( + sink, + options.MethodDisplayOrDefault(), + options.MethodDisplayOptionsOrDefault(), + discoveryMessage.TestCase.TestMethod, + discoveryMessage.TestCase.TestMethodArguments, + SourceInformation = discoveryMessage.TestCase.SourceInformation + ) + | testCase -> testCase + messageBus.QueueMessage(TestCaseDiscoveryMessage customized) + | _ -> + messageBus.QueueMessage message + member _.Dispose () = messageBus.Dispose() } + base.FindTestsForType(testClass, includeSourceInformation, customizingBus, options) + } diff --git a/tests/FSharp.Test.Utilities/XunitSetup.fs b/tests/FSharp.Test.Utilities/XunitSetup.fs new file mode 100644 index 00000000000..4b454c603d7 --- /dev/null +++ b/tests/FSharp.Test.Utilities/XunitSetup.fs @@ -0,0 +1,12 @@ +namespace FSharp.Test + +open Xunit + +/// Exclude from parallelization. Execute test cases in sequence and do not run any other collections at the same time. +[] +type DoNotRunInParallel = class end + +module XUnitSetup = + + [] + do () diff --git a/tests/fsharp/Compiler/CodeGen/EmittedIL/DeterministicTests.fs b/tests/fsharp/Compiler/CodeGen/EmittedIL/DeterministicTests.fs index 057004ff01f..1e9427ad378 100644 --- a/tests/fsharp/Compiler/CodeGen/EmittedIL/DeterministicTests.fs +++ b/tests/fsharp/Compiler/CodeGen/EmittedIL/DeterministicTests.fs @@ -8,7 +8,7 @@ open FSharp.Test.Compiler open Xunit - +[] module DeterministicTests = let commonOptions = ["--refonly";"--deterministic";"--nooptimizationdata"] diff --git a/tests/fsharp/Compiler/Service/MultiProjectTests.fs b/tests/fsharp/Compiler/Service/MultiProjectTests.fs index 9e89927220d..7a5b860d891 100644 --- a/tests/fsharp/Compiler/Service/MultiProjectTests.fs +++ b/tests/fsharp/Compiler/Service/MultiProjectTests.fs @@ -63,7 +63,7 @@ let test() = """ |> SourceText.ofString let _, checkAnswer = - CompilerAssert.Checker.ParseAndCheckFileInProject("test.fs", 0, fsText, fsOptions) + TestContext.Checker.ParseAndCheckFileInProject("test.fs", 0, fsText, fsOptions) |> Async.RunImmediate @@ -128,13 +128,13 @@ let test() = [] let ``Using a CSharp reference project in-memory and it gets GCed``() = let weakRef = AssertInMemoryCSharpReferenceIsValid() - CompilerAssert.Checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() + TestContext.Checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients() GC.Collect(2, GCCollectionMode.Forced, true) Assert.shouldBeFalse(weakRef.IsAlive) [] let ``Using compiler service, file referencing a DLL will correctly update when the referenced DLL file changes``() = - let checker = CompilerAssert.Checker + let checker = TestContext.Checker // Create an assembly with the module Script1 and function x. let dllPath1 = diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index 6673da9f911..7afb977b6aa 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -17,9 +17,9 @@ - - scriptlib.fsx - + + XunitSetup.fs + diff --git a/tests/fsharp/TypeProviderTests.fs b/tests/fsharp/TypeProviderTests.fs index ab9f2e7e5ef..8ce84d59338 100644 --- a/tests/fsharp/TypeProviderTests.fs +++ b/tests/fsharp/TypeProviderTests.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. #if INTERACTIVE //#r @"../../release/net40/bin/FSharp.Compiler.dll" diff --git a/tests/fsharp/XunitHelpers.fs b/tests/fsharp/XunitHelpers.fs index c7e7493c046..a77c6e768e6 100644 --- a/tests/fsharp/XunitHelpers.fs +++ b/tests/fsharp/XunitHelpers.fs @@ -4,9 +4,6 @@ open Xunit module Assert = - [] - do() - let inline fail message = Assert.Fail message let inline failf fmt = Printf.kprintf fail fmt diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index ed99adda96a..a09ff2f3a0e 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -763,7 +763,7 @@ module CoreTests = #endif -#if !NETCOREAPP +#if !NETCOREAPP [] let quotes () = let cfg = testConfig "core/quotes" diff --git a/tests/fsharp/xunit.runner.json b/tests/fsharp/xunit.runner.json index 4e5a48343ec..f47fec5d745 100644 --- a/tests/fsharp/xunit.runner.json +++ b/tests/fsharp/xunit.runner.json @@ -1,5 +1,5 @@ { "$schema": "https://xunit.net/schema/current/xunit.runner.schema.json", - "appDomain": "ifAvailable", - "shadowCopy": false + "appDomain": "denied", + "parallelizeAssembly": true } \ No newline at end of file diff --git a/tests/scripts/scriptlib.fsx b/tests/scripts/scriptlib.fsx index 853aecb496e..ea1a5a63737 100644 --- a/tests/scripts/scriptlib.fsx +++ b/tests/scripts/scriptlib.fsx @@ -10,6 +10,14 @@ open System.IO open System.Text open System.Diagnostics +module MessageSink = + let sinkWriter = +#if DEBUG + Console.Out +#else + TextWriter.Null +#endif + [] module Scripting = @@ -23,7 +31,7 @@ module Scripting = let info = ProcessStartInfo(Arguments=arguments, UseShellExecute=false, RedirectStandardOutput=true, RedirectStandardError=true, CreateNoWindow=true, FileName=fileName) - let p = new Process(StartInfo=info) + use p = new Process(StartInfo=info) p.OutputDataReceived.Add(fun x -> processWriteMessage stdout x.Data) p.ErrorDataReceived.Add(fun x -> processWriteMessage stderr x.Data) if p.Start() then @@ -77,7 +85,7 @@ module Scripting = if Directory.Exists output then Directory.Delete(output, true) - let log format = printfn format + let log format = fprintfn MessageSink.sinkWriter format type FilePath = string @@ -113,7 +121,7 @@ module Scripting = ignore envs // work out what to do about this - let p = new Process() + use p = new Process() p.EnableRaisingEvents <- true p.StartInfo <- processInfo let out = StringBuilder() @@ -155,11 +163,14 @@ module Scripting = p.WaitForExit() + printf $"{string out}" + eprintf $"{string err}" + match p.ExitCode with | 0 -> Success(string out) | errCode -> - let msg = sprintf "Error running command '%s' with args '%s' in directory '%s'.\n---- stdout below --- \n%s\n---- stderr below --- \n%s " exePath arguments workDir (out.ToString()) (err.ToString()) + let msg = sprintf "Error running command '%s' with args '%s' in directory '%s'" exePath arguments workDir ErrorLevel (msg, errCode) type OutPipe (writer: TextWriter) = @@ -169,8 +180,6 @@ module Scripting = let redirectTo (writer: TextWriter) = new OutPipe (writer) - let redirectToLog () = redirectTo System.Console.Out - #if !NETCOREAPP let defaultPlatform = match Environment.OSVersion.Platform, Environment.Is64BitOperatingSystem with @@ -184,7 +193,7 @@ module Scripting = let info = ProcessStartInfo(Arguments=arguments, UseShellExecute=false, RedirectStandardOutput=true, RedirectStandardError=true,RedirectStandardInput=true, CreateNoWindow=true, FileName=fileName) - let p = new Process(StartInfo=info) + use p = new Process(StartInfo=info) if p.Start() then async { try diff --git a/vsintegration/tests/FSharp.Editor.Tests/BraceMatchingServiceTests.fs b/vsintegration/tests/FSharp.Editor.Tests/BraceMatchingServiceTests.fs index 8027a06e85f..638b40d92f5 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/BraceMatchingServiceTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/BraceMatchingServiceTests.fs @@ -11,8 +11,7 @@ open FSharp.Editor.Tests.Helpers open FSharp.Test type BraceMatchingServiceTests() = - let checker = - FSharpChecker.Create(useTransparentCompiler = CompilerAssertHelpers.UseTransparentCompiler) + let checker = TestContext.Checker let fileName = "C:\\test.fs" diff --git a/vsintegration/tests/FSharp.Editor.Tests/EditorFormattingServiceTests.fs b/vsintegration/tests/FSharp.Editor.Tests/EditorFormattingServiceTests.fs index 985abc67e31..da719e12b18 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/EditorFormattingServiceTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/EditorFormattingServiceTests.fs @@ -57,8 +57,7 @@ marker4""" [] [] member this.TestIndentation(marker: string, expectedLine: string) = - let checker = - FSharpChecker.Create(useTransparentCompiler = CompilerAssertHelpers.UseTransparentCompiler) + let checker = TestContext.Checker let position = indentTemplate.IndexOf(marker) Assert.True(position >= 0, "Precondition failed: unable to find marker in template") @@ -96,8 +95,7 @@ marker4""" [] [] member this.TestPasteChanges_PastingOntoIndentedLine(enabled: bool, prefix: string) = - let checker = - FSharpChecker.Create(useTransparentCompiler = CompilerAssertHelpers.UseTransparentCompiler) + let checker = TestContext.Checker let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions RoslynTestHelpers.DefaultProjectOptions @@ -163,8 +161,7 @@ somethingElseHere [] [] member this.TestPasteChanges_PastingOntoEmptyLine(prefix: string) = - let checker = - FSharpChecker.Create(useTransparentCompiler = CompilerAssertHelpers.UseTransparentCompiler) + let checker = TestContext.Checker let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions RoslynTestHelpers.DefaultProjectOptions @@ -224,8 +221,7 @@ somethingElseHere [] member this.TestPasteChanges_PastingWithAutoIndentationInPasteSpan() = - let checker = - FSharpChecker.Create(useTransparentCompiler = CompilerAssertHelpers.UseTransparentCompiler) + let checker = TestContext.Checker let parsingOptions, _ = checker.GetParsingOptionsFromProjectOptions RoslynTestHelpers.DefaultProjectOptions diff --git a/vsintegration/tests/FSharp.Editor.Tests/IndentationServiceTests.fs b/vsintegration/tests/FSharp.Editor.Tests/IndentationServiceTests.fs index 70a7c17dfcf..b9426b3cd4c 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/IndentationServiceTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/IndentationServiceTests.fs @@ -12,8 +12,7 @@ open FSharp.Editor.Tests.Helpers open FSharp.Test type IndentationServiceTests() = - let checker = - FSharpChecker.Create(useTransparentCompiler = CompilerAssertHelpers.UseTransparentCompiler) + let checker = TestContext.Checker let filePath = "C:\\test.fs" diff --git a/vsintegration/tests/FSharp.Editor.Tests/SignatureHelpProviderTests.fs b/vsintegration/tests/FSharp.Editor.Tests/SignatureHelpProviderTests.fs index f85ee51a6c8..7af641bb442 100644 --- a/vsintegration/tests/FSharp.Editor.Tests/SignatureHelpProviderTests.fs +++ b/vsintegration/tests/FSharp.Editor.Tests/SignatureHelpProviderTests.fs @@ -21,8 +21,7 @@ module SignatureHelpProvider = override doc.AppendDocumentation(_, _, _, _, _, _, _, _) = () } - let checker = - FSharpChecker.Create(useTransparentCompiler = CompilerAssertHelpers.UseTransparentCompiler) + let checker = TestContext.Checker let filePath = "C:\\test.fs" From e93a33ed048ee92e7b0e4ef3f013174f7c69703c Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Fri, 25 Oct 2024 15:37:52 +0200 Subject: [PATCH 2/8] orchestrate instead of Async.Sleep --- .../Microsoft.FSharp.Control/Cancellation.fs | 34 +++++++++++++------ 1 file changed, 23 insertions(+), 11 deletions(-) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs index 334ef191c3b..0299c9edf0c 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/Cancellation.fs @@ -12,6 +12,15 @@ open System.Threading.Tasks [] type CancellationType() = + let ordered() = + let mutable current = 1 + + fun n -> + async { + SpinWait.SpinUntil(fun () -> current = n) + Interlocked.Increment ¤t |> ignore + } + [] member this.CancellationNoCallbacks() = let _ : CancellationTokenSource = null // compilation test @@ -234,6 +243,8 @@ type CancellationType() = // See https://github.com/dotnet/fsharp/issues/3254 [] member this.AwaitTaskCancellationAfterAsyncTokenCancellation() = + let step = ordered() + let StartCatchCancellation cancellationToken (work) = Async.FromContinuations(fun (cont, econt, _) -> // When the child is cancelled, report OperationCancelled @@ -267,25 +278,26 @@ type CancellationType() = let tcs = System.Threading.Tasks.TaskCompletionSource<_>() let t = async { + do! step 1 do! tcs.Task |> Async.AwaitTask } |> StartAsTaskProperCancel None (Some cts.Token) // First cancel the token, then set the task as cancelled. - async { - do! Async.Sleep 100 + task { + do! step 2 cts.Cancel() - do! Async.Sleep 100 + do! step 3 tcs.TrySetException (TimeoutException "Task timed out after token.") - |> ignore - } |> Async.Start + |> ignore - try - let res = t.Wait(2000) - let msg = sprintf "Excepted TimeoutException wrapped in an AggregateException, but got %A" res - printfn "failure msg: %s" msg - Assert.Fail (msg) - with :? AggregateException as agg -> () + try + let res = t.Wait() + let msg = sprintf "Excepted TimeoutException wrapped in an AggregateException, but got %A" res + printfn "failure msg: %s" msg + Assert.Fail (msg) + with :? AggregateException as agg -> () + } // Simpler regression test for https://github.com/dotnet/fsharp/issues/3254 [] From 47d9cdccb371cbb85eb59dc800666c4acff79281 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Fri, 25 Oct 2024 18:27:45 +0200 Subject: [PATCH 3/8] xunit customizations behind conditional compilation --- eng/Build.ps1 | 21 +----- tests/FSharp.Test.Utilities/CompilerAssert.fs | 1 - .../FSharp.Test.Utilities.fsproj | 1 + tests/FSharp.Test.Utilities/XunitHelpers.fs | 75 ++++++++----------- 4 files changed, 34 insertions(+), 64 deletions(-) diff --git a/eng/Build.ps1 b/eng/Build.ps1 index d282b47b9ef..3dd4b2bf5a2 100644 --- a/eng/Build.ps1 +++ b/eng/Build.ps1 @@ -646,26 +646,7 @@ try { TestSolutionUsingMSBuild -testSolution "$RepoRoot\FSharp.sln" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -settings $cpuLimit } - if ($testDesktop -and -not $ci) { - - # Split ComponentTests into processes using filter, because it is slow and underutilizes CPU locally. - $bgJob1 = TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -backgroundJob 1 -settings "--filter ExecutionNode=1" - $bgJob2 = TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -backgroundJob 2 -settings "--filter ExecutionNode=2" - $bgJob3 = TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -backgroundJob 3 -settings "--filter ExecutionNode=3" - $bgJob4 = TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -backgroundJob 4 -settings "--filter ExecutionNode=4" - - TestSolutionUsingMSBuild -testSolution "$RepoRoot\FSharp.sln" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -settings " --filter ""Project!=FSharpSuite.Tests&Project!=FSharp.Compiler.ComponentTests"" " - # FSharpSuite does most of it's work in external processes, saturating the CPU. It makes sense to run it separately. - TestUsingMSBuild -testProject "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" - - # Collect output from background jobs - Receive -job $bgJob1 - Receive -job $bgJob2 - Receive -job $bgJob3 - Receive -job $bgJob4 - } - - if ($testDesktop -and $ci) { + if ($testDesktop) { $bgJob = TestUsingMSBuild -testProject "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" -backgroundJob 1 TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index 4fd33216c93..033cd78267a 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -364,7 +364,6 @@ module CompilerAssertHelpers = member x.ExecuteTestCase assemblyPath isFsx = // Set console streams for the AppDomain. TestConsole.initStreamsCapture() - TestConsole.resetWriters() let assembly = Assembly.LoadFrom assemblyPath executeAssemblyEntryPoint assembly isFsx diff --git a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj index 5ec38117917..abd19ebfe57 100644 --- a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj +++ b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj @@ -13,6 +13,7 @@ false $(OtherFlags) --warnon:1182 true + diff --git a/tests/FSharp.Test.Utilities/XunitHelpers.fs b/tests/FSharp.Test.Utilities/XunitHelpers.fs index ad9be928254..b61f5516326 100644 --- a/tests/FSharp.Test.Utilities/XunitHelpers.fs +++ b/tests/FSharp.Test.Utilities/XunitHelpers.fs @@ -1,4 +1,7 @@ +#if XUNIT_CUSTOMIZATIONS #nowarn "0044" +#endif + namespace FSharp.Test open System @@ -11,41 +14,37 @@ open Xunit.Abstractions module internal TestConsole = /// Redirects reads performed on different async execution contexts to the relevant TextReader held by AsyncLocal. - type RedirectingTextReader(initial: TextReader) = + type RedirectingTextReader() = inherit TextReader() let holder = AsyncLocal<_>() - do holder.Value <- initial + do holder.Value <- TextReader.Null override _.Peek() = holder.Value.Peek() override _.Read() = holder.Value.Read() member _.Set (reader: TextReader) = holder.Value <- reader /// Redirects writes performed on different async execution contexts to the relevant TextWriter held by AsyncLocal. - type RedirectingTextWriter(initial: TextWriter) = + type RedirectingTextWriter() = inherit TextWriter() - let holder = AsyncLocal<_>() - do holder.Value <- initial + let holder = AsyncLocal() + let getValue() = holder.Value |> Option.ofObj |> Option.defaultWith (fun () -> holder.Value <- new StringWriter(); holder.Value) override _.Encoding = Encoding.UTF8 - override _.Write(value: char) = holder.Value.Write(value) - override _.Write(value: string) = holder.Value.Write(value) - override _.WriteLine(value: string) = holder.Value.WriteLine(value) - member _.Value = holder.Value + override _.Write(value: char) = getValue().Write(value) + override _.Write(value: string) = getValue().Write(value) + override _.WriteLine(value: string) = getValue().WriteLine(value) + member _.Value = getValue() member _.Set (writer: TextWriter) = holder.Value <- writer - let localIn = new RedirectingTextReader(TextReader.Null) - let localOut = new RedirectingTextWriter(TextWriter.Null) - let localError = new RedirectingTextWriter(TextWriter.Null) + let localIn = new RedirectingTextReader() + let localOut = new RedirectingTextWriter() + let localError = new RedirectingTextWriter() let initStreamsCapture () = Console.SetIn localIn Console.SetOut localOut Console.SetError localError - let resetWriters() = - new StringWriter() |> localOut.Set - new StringWriter() |> localError.Set - type TestConsole = static member OutText = Console.Out.Flush() @@ -56,6 +55,13 @@ type TestConsole = string TestConsole.localError.Value +/// Disables custom internal parallelization. +/// Execute test cases in a class or a module one by one instead of all at once. Allow other collections to run simultaneously. +[] +type RunInSequenceAttribute() = inherit Attribute() + +#if XUNIT_CUSTOMIZATIONS + // To use xUnit means to customize it. The following abomination adds 3 features: // - Capturing console output individually and in parallel for each test // - Internally parallelize test classes and theories. Test cases and theory cases included in a single class or F# module can execute simultaneously @@ -68,7 +74,6 @@ type ConsoleCapturingTestRunner(test, messageBus, testClass, constructorArgument member _.BaseInvokeTestMethodAsync aggregator = base.InvokeTestMethodAsync aggregator override this.InvokeTestAsync (aggregator: ExceptionAggregator): Tasks.Task = task { - TestConsole.resetWriters() let! executionTime = this.BaseInvokeTestMethodAsync aggregator let output = seq { @@ -82,11 +87,6 @@ type ConsoleCapturingTestRunner(test, messageBus, testClass, constructorArgument return executionTime, output } -/// Disables custom internal parallelization. -/// Execute test cases in a class or a module one by one instead of all at once. Allow other collections to run simultaneously. -[] -type RunInSequenceAttribute() = inherit Attribute() - module TestCaseCustomizations = // Internally parallelize test classes and theories. // Based on https://www.meziantou.net/parallelize-test-cases-execution-in-xunit.htm @@ -120,23 +120,6 @@ module TestCaseCustomizations = else testCase.TestMethod - let addTraits (testCase: ITestCase) = - // Proof of concept. - // Distribute test cases reasonably evenly among number of execution nodes. - // This might be helpful when running tests with parallel multi-agent strategy in CI. - // SHA256 is probably overkill, but the assignment must be stable between test discoveries. - let hashAlgorithm = Security.Cryptography.SHA256.Create() - let assignNode numberOfBuckets = - let bytes = hashAlgorithm.ComputeHash(Encoding.UTF8.GetBytes(testCase.UniqueID)) - let stableHashValue = BitConverter.ToUInt32(bytes, 0) - stableHashValue % uint numberOfBuckets + 1u |> string - - // Add `Project` trait so a project can be selected or filtered out during a full solution test run. Example: --filter Project=FSharp.Compiler.ComponentTests - testCase.Traits["Project"] <- ResizeArray [ testCase.TestMethod.TestClass.TestCollection.TestAssembly.Assembly.Name.Split(',')[0] ] - // Assign test case to one of buckets numbered 1 .. 4 to easily distribute execution among many agents in CI. Example: --filter ExecutionNode=4 - // Number of nodes hardcoded as 4 here could eventually come from an env variable set by the CI. - testCase.Traits["ExecutionNode"] <- ResizeArray [ assignNode 4 ] - type CustomTestCase = inherit XunitTestCase // xUinit demands this constructor for deserialization. @@ -156,7 +139,6 @@ type CustomTestCase = override testCase.Initialize () = base.Initialize() testCase.TestMethod <- TestCaseCustomizations.rewriteTestMethod testCase - TestCaseCustomizations.addTraits testCase type CustomTheoryTestCase = inherit XunitTheoryTestCase @@ -175,15 +157,20 @@ type CustomTheoryTestCase = override testCase.Initialize () = base.Initialize() testCase.TestMethod <- TestCaseCustomizations.rewriteTestMethod testCase - TestCaseCustomizations.addTraits testCase + +#endif /// Customized test framework providing console support and better parallelization for F# tests. type TestRun(sink: IMessageSink) = inherit XunitTestFramework(sink) do - // Init statics + // Because xUnit v2 lacks assembly fixture, the next best place to ensure things get called + // right at the start of the test run is here in the constructor. + // This gets executed once per test assembly. MessageSink.sinkWriter |> ignore - TestConsole.initStreamsCapture() + TestConsole.initStreamsCapture() + +#if XUNIT_CUSTOMIZATIONS override this.CreateDiscoverer (assemblyInfo) = { new XunitTestFrameworkDiscoverer(assemblyInfo, this.SourceInformationProvider, this.DiagnosticMessageSink) with @@ -220,3 +207,5 @@ type TestRun(sink: IMessageSink) = member _.Dispose () = messageBus.Dispose() } base.FindTestsForType(testClass, includeSourceInformation, customizingBus, options) } + +#endif From 83c5b98fe78e45c0badbd7461755315797d55546 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Sun, 27 Oct 2024 20:37:47 +0100 Subject: [PATCH 4/8] make console capture explicit --- .../Miscellaneous/FsharpSuiteMigrated.fs | 3 +- .../DependencyManagerInteractiveTests.fs | 136 +++++++----------- .../FSharpScriptTests.fs | 39 ++--- tests/FSharp.Test.Utilities/Compiler.fs | 10 +- tests/FSharp.Test.Utilities/CompilerAssert.fs | 40 +++--- .../FSharp.Test.Utilities.fsproj | 4 +- tests/FSharp.Test.Utilities/ScriptHelpers.fs | 37 +---- tests/FSharp.Test.Utilities/TestConsole.fs | 81 +++++++++++ tests/FSharp.Test.Utilities/XunitHelpers.fs | 88 ++++-------- tests/FSharp.Test.Utilities/XunitSetup.fs | 2 +- 10 files changed, 200 insertions(+), 240 deletions(-) create mode 100644 tests/FSharp.Test.Utilities/TestConsole.fs diff --git a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FsharpSuiteMigrated.fs b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FsharpSuiteMigrated.fs index 16c90229498..6e220168fef 100644 --- a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FsharpSuiteMigrated.fs +++ b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FsharpSuiteMigrated.fs @@ -31,12 +31,13 @@ module ScriptRunner = let cu = cu |> withDefines defaultDefines match cu with | FS fsSource -> + use capture = new TestConsole.ExecutionCapture() let engine = createEngine (fsSource.Options |> Array.ofList,version) let res = evalScriptFromDiskInSharedSession engine cu match res with | CompilationResult.Failure _ -> res | CompilationResult.Success _ -> - if TestConsole.OutText |> TestFramework.outputPassed then + if capture.OutText |> TestFramework.outputPassed then res else failwith $"Results looked correct, but 'TEST PASSED OK' was not printed." diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/DependencyManagerInteractiveTests.fs b/tests/FSharp.Compiler.Private.Scripting.UnitTests/DependencyManagerInteractiveTests.fs index 8b4be398ddd..1c99df5c311 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/DependencyManagerInteractiveTests.fs +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/DependencyManagerInteractiveTests.fs @@ -722,101 +722,65 @@ x |> Seq.iter(fun r -> [] member _.``Verify that #help produces help text for fsi + dependency manager``() = - let expected = [| - """ F# Interactive directives:""" - """""" - """ #r "file.dll";; // Reference (dynamically load) the given DLL""" - """ #i "package source uri";; // Include package source uri when searching for packages""" - """ #I "path";; // Add the given search path for referenced DLLs""" - """ #load "file.fs" ...;; // Load the given file(s) as if compiled and referenced""" - """ #time ["on"|"off"];; // Toggle timing on/off""" - """ #clear;; // Clear screen""" - """ #help;; // Display help""" - """ #help "idn";; // Display documentation for an identifier, e.g. #help "List.map";;""" - """ #quit;; // Exit""" - """""" - """ F# Interactive command line options:""" - """""" - - // this is the end of the line each different platform has a different mechanism for starting fsi - // Actual output looks similar to: """ See 'testhost --help' for options""" - """--help' for options""" - - """""" - """""" - |] + let expected = """ + F# Interactive directives: + + #r "file.dll";; // Reference (dynamically load) the given DLL + #i "package source uri";; // Include package source uri when searching for packages + #I "path";; // Add the given search path for referenced DLLs + #load "file.fs" ...;; // Load the given file(s) as if compiled and referenced + #time ["on"|"off"];; // Toggle timing on/off + #help;; // Display help + #help "idn";; // Display documentation for an identifier, e.g. #help "List.map";; + #clear;; // Clear screen + #quit;; // Exit + + F# Interactive command line options:""" - let mutable found = 0 - let lines = System.Collections.Generic.List() - use sawExpectedOutput = new ManualResetEvent(false) - let verifyOutput (line: string) = - let compareLine (s: string) = - if s = "" then line = "" - else line.EndsWith(s) - lines.Add(line) - match expected |> Array.tryFind(compareLine) with - | None -> () - | Some t -> - found <- found + 1 - if found = expected.Length then sawExpectedOutput.Set() |> ignore - - let text = "#help" use script = new FSharpScript(quiet = false, langVersion = LangVersion.V47) - let mutable found = 0 - script.OutputProduced.Add (fun line -> verifyOutput line) - let opt = script.Eval(text) |> getValue - Assert.True(sawExpectedOutput.WaitOne(TimeSpan.FromSeconds(5.0)), sprintf "Expected to see error sentinel value written\nexpected:%A\nactual:%A" expected lines) + use capture = new TestConsole.ExecutionCapture() + let opt = script.Eval("#help") |> getValue + + let output = capture.OutText + + Assert.Contains(expected, output) + + // this is the end of the line each different platform has a different mechanism for starting fsi + // Actual output looks similar to: """ See 'testhost --help' for options""" + Assert.EndsWith("--help' for options", output.Trim()) [] member _.``Verify that #help produces help text for fsi + dependency manager language version preview``() = - let expected = [| - """ F# Interactive directives:""" - """""" - """ #r "file.dll";; // Reference (dynamically load) the given DLL""" - """ #i "package source uri";; // Include package source uri when searching for packages""" - """ #I "path";; // Add the given search path for referenced DLLs""" - """ #load "file.fs" ...;; // Load the given file(s) as if compiled and referenced""" - """ #time ["on"|"off"];; // Toggle timing on/off""" - """ #help;; // Display help""" - """ #help "idn";; // Display documentation for an identifier, e.g. #help "List.map";;""" - """ #r "nuget:FSharp.Data, 3.1.2";; // Load Nuget Package 'FSharp.Data' version '3.1.2'""" - """ #r "nuget:FSharp.Data";; // Load Nuget Package 'FSharp.Data' with the highest version""" - """ #clear;; // Clear screen""" - """ #quit;; // Exit""" - """""" - """ F# Interactive command line options:""" - """""" - - // this is the end of the line each different platform has a different mechanism for starting fsi - // Actual output looks similar to: """ See 'testhost --help' for options""" - """--help' for options""" - - """""" - """""" - |] + let expected = """ + F# Interactive directives: + + #r "file.dll";; // Reference (dynamically load) the given DLL + #i "package source uri";; // Include package source uri when searching for packages + #I "path";; // Add the given search path for referenced DLLs + #load "file.fs" ...;; // Load the given file(s) as if compiled and referenced + #time ["on"|"off"];; // Toggle timing on/off + #help;; // Display help + #help "idn";; // Display documentation for an identifier, e.g. #help "List.map";; + #r "nuget:FSharp.Data, 3.1.2";; // Load Nuget Package 'FSharp.Data' version '3.1.2' + #r "nuget:FSharp.Data";; // Load Nuget Package 'FSharp.Data' with the highest version + #clear;; // Clear screen + #quit;; // Exit + + F# Interactive command line options:""" - let mutable found = 0 - let lines = System.Collections.Generic.List() - use sawExpectedOutput = new ManualResetEvent(false) - let verifyOutput (line: string) = - let compareLine (s: string) = - if s = "" then line = "" - else line.EndsWith(s) - lines.Add(line) - match expected |> Array.tryFind(compareLine) with - | None -> () - | Some t -> - found <- found + 1 - if found = expected.Length then sawExpectedOutput.Set() |> ignore - - let text = "#help" use script = new FSharpScript(quiet = false, langVersion = LangVersion.Preview) - let mutable found = 0 - script.OutputProduced.Add (fun line -> verifyOutput line) - let opt = script.Eval(text) |> getValue - Assert.True(sawExpectedOutput.WaitOne(TimeSpan.FromSeconds(5.0)), sprintf "Expected to see error sentinel value written\nexpected:%A\nactual:%A" expected lines) + use capture = new TestConsole.ExecutionCapture() + let opt = script.Eval("#help") |> getValue + + let output = capture.OutText + + Assert.Contains(expected, output) + + // this is the end of the line each different platform has a different mechanism for starting fsi + // Actual output looks similar to: """ See 'testhost --help' for options""" + Assert.EndsWith("--help' for options", output.Trim()) [] member _.``Verify that timeout --- times out and fails``() = diff --git a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs index 6bbf60a8dcc..58a2e0e709c 100644 --- a/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs +++ b/tests/FSharp.Compiler.Private.Scripting.UnitTests/FSharpScriptTests.fs @@ -3,6 +3,7 @@ namespace FSharp.Compiler.Scripting.UnitTests open System +open System.Text open System.Diagnostics open System.IO open System.Reflection @@ -11,6 +12,7 @@ open System.Threading open System.Threading.Tasks open FSharp.Compiler.Interactive open FSharp.Compiler.Interactive.Shell +open FSharp.Test open FSharp.Test.ScriptHelpers open Xunit @@ -85,25 +87,6 @@ x ) #endif - [] - member _.``Capture console input``() = - use script = new FSharpScript(input = "stdin:1234\r\n") - let opt = script.Eval("System.Console.ReadLine()") |> getValue - let value = opt.Value - Assert.Equal(typeof, value.ReflectionType) - Assert.Equal("stdin:1234", downcast value.ReflectionValue) - - [] - member _.``Capture console output/error``() = - use script = new FSharpScript() - use sawOutputSentinel = new ManualResetEvent(false) - use sawErrorSentinel = new ManualResetEvent(false) - script.OutputProduced.Add (fun line -> if line = "stdout:1234" then sawOutputSentinel.Set() |> ignore) - script.ErrorProduced.Add (fun line -> if line = "stderr:5678" then sawErrorSentinel.Set() |> ignore) - script.Eval("printfn \"stdout:1234\"; eprintfn \"stderr:5678\"") |> ignoreValue - Assert.True(sawOutputSentinel.WaitOne(TimeSpan.FromSeconds(5.0)), "Expected to see output sentinel value written") - Assert.True(sawErrorSentinel.WaitOne(TimeSpan.FromSeconds(5.0)), "Expected to see error sentinel value written") - [] member _.``Maintain state between submissions``() = use script = new FSharpScript() @@ -306,30 +289,26 @@ printfn "{@"%A"}" result [] member _.``Eval script with invalid PackageName should fail immediately``() = + use capture = new TestConsole.ExecutionCapture() use script = new FSharpScript(additionalArgs=[| |]) - let mutable found = 0 - let outp = System.Collections.Generic.List() - script.OutputProduced.Add( - fun line -> - if line.Contains("error NU1101:") && line.Contains("FSharp.Really.Not.A.Package") then - found <- found + 1 - outp.Add(line)) let result, errors = script.Eval("""#r "nuget:FSharp.Really.Not.A.Package" """) - Assert.True( (found = 0), "Did not expect to see output contains 'error NU1101:' and 'FSharp.Really.Not.A.Package'") + + let lines = capture.OutText.Split([| Environment.NewLine |], StringSplitOptions.None) + let found = lines |> Seq.exists (fun line -> line.Contains("error NU1101:") && line.Contains("FSharp.Really.Not.A.Package")) + Assert.False(found, "Did not expect to see output contains 'error NU1101:' and 'FSharp.Really.Not.A.Package'") Assert.True( errors |> Seq.exists (fun error -> error.Message.Contains("error NU1101:")), "Expect to error containing 'error NU1101:'") Assert.True( errors |> Seq.exists (fun error -> error.Message.Contains("FSharp.Really.Not.A.Package")), "Expect to error containing 'FSharp.Really.Not.A.Package'") [] member _.``Eval script with invalid PackageName should fail immediately and resolve one time only``() = + use capture = new TestConsole.ExecutionCapture() use script = new FSharpScript(additionalArgs=[| |]) - let mutable foundResolve = 0 - script.OutputProduced.Add (fun line -> if line.Contains("error NU1101:") then foundResolve <- foundResolve + 1) let result, errors = script.Eval(""" #r "nuget:FSharp.Really.Not.A.Package" #r "nuget:FSharp.Really.Not.Another.Package" """) - Assert.True( (foundResolve = 0), (sprintf "Did not expected to see 'error NU1101:' in output" )) + Assert.DoesNotContain("error NU1101:", capture.OutText) Assert.Equal(2, (errors |> Seq.filter (fun error -> error.Message.Contains("error NU1101:")) |> Seq.length)) Assert.Equal(1, (errors |> Seq.filter (fun error -> error.Message.Contains("FSharp.Really.Not.A.Package")) |> Seq.length)) Assert.Equal(1, (errors |> Seq.filter (fun error -> error.Message.Contains("FSharp.Really.Not.Another.Package")) |> Seq.length)) diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index 5a8482e2204..118af638a1b 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -701,6 +701,8 @@ module rec Compiler = let private compileFSharpCompilation compilation ignoreWarnings (cUnit: CompilationUnit) : CompilationResult = + use capture = new TestConsole.ExecutionCapture() + let ((err: FSharpDiagnostic[], exn, outputFilePath: string), deps) = CompilerAssert.CompileRaw(compilation, ignoreWarnings) @@ -715,7 +717,7 @@ module rec Compiler = Adjust = 0 PerFileErrors = diagnostics Diagnostics = diagnostics |> List.map snd - Output = Some (RunOutput.ExecutionOutput { Outcome = outcome; StdOut = TestConsole.OutText; StdErr = TestConsole.ErrorText }) + Output = Some (RunOutput.ExecutionOutput { Outcome = outcome; StdOut = capture.OutText; StdErr = capture.ErrorText }) Compilation = cUnit } @@ -1012,8 +1014,9 @@ module rec Compiler = let private evalFSharp (fs: FSharpCompilationSource) (script:FSharpScript) : CompilationResult = let source = fs.Source.GetSourceText |> Option.defaultValue "" + use capture = new TestConsole.ExecutionCapture() let result = script.Eval(source) - let outputWritten, errorsWritten = TestConsole.OutText, TestConsole.ErrorText + let outputWritten, errorsWritten = capture.OutText, capture.ErrorText processScriptResults fs result outputWritten errorsWritten let scriptingShim = Path.Combine(__SOURCE_DIRECTORY__,"ScriptingShims.fsx") @@ -1026,8 +1029,9 @@ module rec Compiler = |> List.map (sprintf " @\"%s\"") |> String.Concat + use capture = new TestConsole.ExecutionCapture() let result = script.Eval("#load " + fileNames) - let outputWritten, errorsWritten = TestConsole.OutText, TestConsole.ErrorText + let outputWritten, errorsWritten = capture.OutText, capture.ErrorText processScriptResults fs result outputWritten errorsWritten let eval (cUnit: CompilationUnit) : CompilationResult = diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index 033cd78267a..32a17307862 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -335,6 +335,8 @@ module CompilerAssertHelpers = else entryPoint let args = mkDefaultArgs entryPoint + + use capture = new TestConsole.ExecutionCapture() let outcome = try match entryPoint.Invoke(Unchecked.defaultof, args) with @@ -342,7 +344,7 @@ module CompilerAssertHelpers = | _ -> NoExitCode with | exn -> Failure exn - outcome, TestConsole.OutText, TestConsole.ErrorText + outcome, capture.OutText, capture.ErrorText #if NETCOREAPP let executeBuiltApp assemblyPath deps isFsx = @@ -363,7 +365,7 @@ module CompilerAssertHelpers = member x.ExecuteTestCase assemblyPath isFsx = // Set console streams for the AppDomain. - TestConsole.initStreamsCapture() + TestConsole.install() let assembly = Assembly.LoadFrom assemblyPath executeAssemblyEntryPoint assembly isFsx @@ -626,9 +628,9 @@ module CompilerAssertHelpers = File.WriteAllText(runtimeconfigPath, runtimeconfig) #endif let rc, output, errors = Commands.executeProcess fileName arguments (Path.GetDirectoryName(outputFilePath)) - String.Join(Environment.NewLine, output) |> printf "%s" - String.Join(Environment.NewLine, errors) |> eprintf "%s" - ExitCode rc, TestConsole.OutText, TestConsole.ErrorText + let output = String.Join(Environment.NewLine, output) + let errors = String.Join(Environment.NewLine, errors) + ExitCode rc, output, errors open CompilerAssertHelpers @@ -707,7 +709,7 @@ Updated automatically, please check diffs in your pull request, changes must be executeBuiltAppNewProcess outputFilePath { Outcome = outcome; StdOut = output; StdErr = errors} - static member Execute(cmpl: Compilation, ?ignoreWarnings, ?beforeExecute, ?newProcess) = + static member ExecuteAux(cmpl: Compilation, ?ignoreWarnings, ?beforeExecute, ?newProcess) = let copyDependenciesToOutputDir (outputFilePath:string) (deps: string list) = let outputDirectory = Path.GetDirectoryName(outputFilePath) @@ -722,21 +724,23 @@ Updated automatically, please check diffs in your pull request, changes must be compileCompilation ignoreWarnings cmpl (fun ((errors, _, outputFilePath), deps) -> assertErrors 0 ignoreWarnings errors [||] beforeExecute outputFilePath deps - let outcome, _, _ = - if newProcess then - executeBuiltAppNewProcess outputFilePath - else - executeBuiltApp outputFilePath deps false - - match outcome with - | ExitCode n when n <> 0 -> failwith $"Process exited with code {n}." - | Failure exn -> raise exn - | _ -> () + if newProcess then + executeBuiltAppNewProcess outputFilePath + else + executeBuiltApp outputFilePath deps false ) + static member Execute(cmpl: Compilation, ?ignoreWarnings, ?beforeExecute, ?newProcess) = + let outcome, _, _ = CompilerAssert.ExecuteAux(cmpl, ?ignoreWarnings = ignoreWarnings, ?beforeExecute = beforeExecute, ?newProcess = newProcess) + match outcome with + | ExitCode n when n <> 0 -> failwith $"Process exited with code {n}." + | Failure exn -> raise exn + | _ -> () + + static member ExecutionHasOutput(cmpl: Compilation, expectedOutput: string) = - CompilerAssert.Execute(cmpl, newProcess = true) - Assert.Equal(expectedOutput, TestConsole.OutText) + let _, output, _ = CompilerAssert.ExecuteAux(cmpl, newProcess = true) + Assert.Equal(expectedOutput, output) static member Pass (source: string) = let parseResults, fileAnswer = TestContext.Checker.ParseAndCheckFileInProject("test.fs", 0, SourceText.ofString source, defaultProjectOptions TargetFramework.Current) |> Async.RunImmediate diff --git a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj index abd19ebfe57..3abb34d3c2c 100644 --- a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj +++ b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj @@ -13,7 +13,8 @@ false $(OtherFlags) --warnon:1182 true - + + @@ -30,6 +31,7 @@ scriptlib.fsx + diff --git a/tests/FSharp.Test.Utilities/ScriptHelpers.fs b/tests/FSharp.Test.Utilities/ScriptHelpers.fs index 238755c0eaa..9ed9717d352 100644 --- a/tests/FSharp.Test.Utilities/ScriptHelpers.fs +++ b/tests/FSharp.Test.Utilities/ScriptHelpers.fs @@ -24,27 +24,6 @@ type LangVersion = | Latest | SupportsMl -type private EventedTextWriter() = - inherit TextWriter() - let sb = StringBuilder() - let sw = new StringWriter() - let lineWritten = Event() - member _.LineWritten = lineWritten.Publish - override _.Encoding = Encoding.UTF8 - override _.Write(c: char) = - if c = '\n' then - let line = - let v = sb.ToString() - if v.EndsWith("\r") then v.Substring(0, v.Length - 1) - else v - sb.Clear() |> ignore - sw.WriteLine line - lineWritten.Trigger(line) - else sb.Append(c) |> ignore - override _.ToString() = - sw.Flush() - sw.ToString() - type FSharpScript(?additionalArgs: string[], ?quiet: bool, ?langVersion: LangVersion, ?input: string) = do ignore input @@ -75,33 +54,19 @@ type FSharpScript(?additionalArgs: string[], ?quiet: bool, ?langVersion: LangVer |] let argv = Array.append baseArgs additionalArgs - - let outWriter = new EventedTextWriter() - let errorWriter = new EventedTextWriter() - let fsi = FsiEvaluationSession.Create (config, argv, stdin, TextWriter.Synchronized outWriter, TextWriter.Synchronized errorWriter) + let fsi = FsiEvaluationSession.Create (config, argv, stdin, stdout, stderr) member _.ValueBound = fsi.ValueBound member _.Fsi = fsi - member _.OutputProduced = outWriter.LineWritten - - member _.ErrorProduced = errorWriter.LineWritten - - member _.GetOutput() = string outWriter - - member _.GetErrorOutput() = string errorWriter - member this.Eval(code: string, ?cancellationToken: CancellationToken, ?desiredCulture: Globalization.CultureInfo) = let originalCulture = Thread.CurrentThread.CurrentCulture Thread.CurrentThread.CurrentCulture <- Option.defaultValue Globalization.CultureInfo.InvariantCulture desiredCulture let cancellationToken = defaultArg cancellationToken CancellationToken.None let ch, errors = fsi.EvalInteractionNonThrowing(code, cancellationToken) - // Replay output to test console. - printf $"{this.GetOutput()}" - eprintf $"{this.GetErrorOutput()}" Thread.CurrentThread.CurrentCulture <- originalCulture diff --git a/tests/FSharp.Test.Utilities/TestConsole.fs b/tests/FSharp.Test.Utilities/TestConsole.fs new file mode 100644 index 00000000000..f362bd7eb18 --- /dev/null +++ b/tests/FSharp.Test.Utilities/TestConsole.fs @@ -0,0 +1,81 @@ +namespace FSharp.Test + +open System +open System.IO +open System.Text +open System.Threading + +module TestConsole = + + /// Redirects reads performed on different async execution contexts to the relevant TextReader held by AsyncLocal. + type RedirectingTextReader() = + inherit TextReader() + let holder = AsyncLocal<_>() + do holder.Value <- TextReader.Null + + override _.Peek() = holder.Value.Peek() + override _.Read() = holder.Value.Read() + member _.Value = holder.Value + member _.Set (reader: TextReader) = holder.Value <- reader + + /// Redirects writes performed on different async execution contexts to the relevant TextWriter held by AsyncLocal. + type RedirectingTextWriter() = + inherit TextWriter() + let holder = AsyncLocal() + do holder.Value <- TextWriter.Null + + override _.Encoding = Encoding.UTF8 + override _.Write(value: char) = holder.Value.Write(value) + override _.Write(value: string) = holder.Value.Write(value) + override _.WriteLine(value: string) = holder.Value.WriteLine(value) + member _.Value = holder.Value + member _.Set (writer: TextWriter) = holder.Value <- writer + + let localIn = new RedirectingTextReader() + let localOut = new RedirectingTextWriter() + let localError = new RedirectingTextWriter() + + let install () = + Console.SetIn localIn + Console.SetOut localOut + Console.SetError localError + + // Taps into the redirected console stream. + type CapturingWriter(redirecting: RedirectingTextWriter) as this = + inherit StringWriter() + let wrapped = redirecting.Value + do redirecting.Set this + override _.Encoding = Encoding.UTF8 + override _.Write(value: char) = wrapped.Write(value); base.Write(value) + override _.Write(value: string) = wrapped.Write(value); base.Write(value) + override _.WriteLine(value: string) = wrapped.WriteLine(value); base.Write(value) + override _.Dispose (disposing: bool) = + redirecting.Set wrapped + base.Dispose(disposing: bool) + + /// Captures console streams for the current async execution context. + /// Each simultaneously executing test case runs in a separate async execution context. + /// + /// Can be used to capture just a single compilation or eval as well as the whole test case execution output. + type ExecutionCapture() = + do + Console.Out.Flush() + Console.Error.Flush() + + let output = new CapturingWriter(localOut) + let error = new CapturingWriter(localError) + + member _.Dispose() = + output.Dispose() + error.Dispose() + + interface IDisposable with + member this.Dispose (): unit = this.Dispose() + + member _.OutText = + Console.Out.Flush() + string output + + member _.ErrorText = + Console.Error.Flush() + string error \ No newline at end of file diff --git a/tests/FSharp.Test.Utilities/XunitHelpers.fs b/tests/FSharp.Test.Utilities/XunitHelpers.fs index b61f5516326..07c3dd3df5c 100644 --- a/tests/FSharp.Test.Utilities/XunitHelpers.fs +++ b/tests/FSharp.Test.Utilities/XunitHelpers.fs @@ -1,88 +1,52 @@ -#if XUNIT_CUSTOMIZATIONS +#if XUNIT_EXTRAS #nowarn "0044" #endif namespace FSharp.Test open System -open System.IO -open System.Text -open System.Threading - open Xunit.Sdk open Xunit.Abstractions -module internal TestConsole = - /// Redirects reads performed on different async execution contexts to the relevant TextReader held by AsyncLocal. - type RedirectingTextReader() = - inherit TextReader() - let holder = AsyncLocal<_>() - do holder.Value <- TextReader.Null - - override _.Peek() = holder.Value.Peek() - override _.Read() = holder.Value.Read() - member _.Set (reader: TextReader) = holder.Value <- reader - - /// Redirects writes performed on different async execution contexts to the relevant TextWriter held by AsyncLocal. - type RedirectingTextWriter() = - inherit TextWriter() - let holder = AsyncLocal() - let getValue() = holder.Value |> Option.ofObj |> Option.defaultWith (fun () -> holder.Value <- new StringWriter(); holder.Value) - - override _.Encoding = Encoding.UTF8 - override _.Write(value: char) = getValue().Write(value) - override _.Write(value: string) = getValue().Write(value) - override _.WriteLine(value: string) = getValue().WriteLine(value) - member _.Value = getValue() - member _.Set (writer: TextWriter) = holder.Value <- writer - - let localIn = new RedirectingTextReader() - let localOut = new RedirectingTextWriter() - let localError = new RedirectingTextWriter() - - let initStreamsCapture () = - Console.SetIn localIn - Console.SetOut localOut - Console.SetError localError - -type TestConsole = - static member OutText = - Console.Out.Flush() - string TestConsole.localOut.Value - - static member ErrorText = - Console.Error.Flush() - string TestConsole.localError.Value - - -/// Disables custom internal parallelization. +/// Disables custom internal parallelization added with XUNIT_EXTRAS. /// Execute test cases in a class or a module one by one instead of all at once. Allow other collections to run simultaneously. [] type RunInSequenceAttribute() = inherit Attribute() -#if XUNIT_CUSTOMIZATIONS +#if !XUNIT_EXTRAS +/// Installs console support for parallel test runs and conditionally enables optional xUnit customizations. +type FSharpXunitFramework(sink: IMessageSink) = + inherit XunitTestFramework(sink) + do + // Because xUnit v2 lacks assembly fixture, the next best place to ensure things get called + // right at the start of the test run is here in the constructor. + // This gets executed once per test assembly. + MessageSink.sinkWriter |> ignore + TestConsole.install() + +#else -// To use xUnit means to customize it. The following abomination adds 3 features: -// - Capturing console output individually and in parallel for each test +// To use xUnit means to customize it. The following abomination adds 2 features: +// - Capturing full console output individually for each test case, viewable in Test Explorer as test stdout. // - Internally parallelize test classes and theories. Test cases and theory cases included in a single class or F# module can execute simultaneously -// - Add some autogenerated traits for filtering tests /// Passes captured console output to xUnit. type ConsoleCapturingTestRunner(test, messageBus, testClass, constructorArguments, testMethod, testMethodArguments, skipReason, beforeAfterAttributes, aggregator, cancellationTokenSource) = inherit XunitTestRunner(test, messageBus, testClass, constructorArguments, testMethod, testMethodArguments, skipReason, beforeAfterAttributes, aggregator, cancellationTokenSource) member _.BaseInvokeTestMethodAsync aggregator = base.InvokeTestMethodAsync aggregator - override this.InvokeTestAsync (aggregator: ExceptionAggregator): Tasks.Task = + override this.InvokeTestAsync (aggregator: ExceptionAggregator) = task { + use capture = new TestConsole.ExecutionCapture() let! executionTime = this.BaseInvokeTestMethodAsync aggregator let output = seq { - TestConsole.OutText - if not (String.IsNullOrEmpty TestConsole.ErrorText) then + capture.OutText + if not (String.IsNullOrEmpty capture.ErrorText) then "" "=========== Standard Error ===========" "" - TestConsole.ErrorText + capture.ErrorText } |> String.concat Environment.NewLine return executionTime, output } @@ -158,19 +122,15 @@ type CustomTheoryTestCase = base.Initialize() testCase.TestMethod <- TestCaseCustomizations.rewriteTestMethod testCase -#endif - -/// Customized test framework providing console support and better parallelization for F# tests. -type TestRun(sink: IMessageSink) = +/// `XunitTestFramework` providing parallel console support and conditionally enabling optional xUnit customizations. +type FSharpXunitFramework(sink: IMessageSink) = inherit XunitTestFramework(sink) do // Because xUnit v2 lacks assembly fixture, the next best place to ensure things get called // right at the start of the test run is here in the constructor. // This gets executed once per test assembly. MessageSink.sinkWriter |> ignore - TestConsole.initStreamsCapture() - -#if XUNIT_CUSTOMIZATIONS + TestConsole.install() override this.CreateDiscoverer (assemblyInfo) = { new XunitTestFrameworkDiscoverer(assemblyInfo, this.SourceInformationProvider, this.DiagnosticMessageSink) with diff --git a/tests/FSharp.Test.Utilities/XunitSetup.fs b/tests/FSharp.Test.Utilities/XunitSetup.fs index 4b454c603d7..1718d7e794f 100644 --- a/tests/FSharp.Test.Utilities/XunitSetup.fs +++ b/tests/FSharp.Test.Utilities/XunitSetup.fs @@ -8,5 +8,5 @@ type DoNotRunInParallel = class end module XUnitSetup = - [] + [] do () From 1ef5c8d23e2ed9111179c464006293191581a587 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 28 Oct 2024 10:13:31 +0100 Subject: [PATCH 5/8] diff --- eng/Build.ps1 | 102 ++++++------------ .../Microsoft.FSharp.Control/AsyncModule.fs | 2 +- tests/FSharp.Test.Utilities/ScriptHelpers.fs | 4 +- 3 files changed, 32 insertions(+), 76 deletions(-) diff --git a/eng/Build.ps1 b/eng/Build.ps1 index 3dd4b2bf5a2..ab7383a7dde 100644 --- a/eng/Build.ps1 +++ b/eng/Build.ps1 @@ -362,14 +362,13 @@ function VerifyAssemblyVersionsAndSymbols() { } } -function TestUsingMSBuild([string] $testProject, [string] $targetFramework, [string]$testadapterpath, [string] $backgroundJob = "", [string] $settings = "") { - $jobId = if ($backgroundJob) { "_$backgroundJob"} else {""} +function TestUsingMSBuild([string] $path, [string] $targetFramework, [string]$testadapterpath, [boolean] $asBackgroundJob = $false, [string] $settings = "") { $dotnetPath = InitializeDotNetCli $dotnetExe = Join-Path $dotnetPath "dotnet.exe" - $projectName = [System.IO.Path]::GetFileNameWithoutExtension($testProject) - $testLogPath = "$ArtifactsDir\TestResults\$configuration\${projectName}_$targetFramework$jobId.xml" - $testBinLogPath = "$LogDir\${projectName}_$targetFramework$jobId.binlog" - $arguments = "test $testProject -c $configuration -f $targetFramework -v n --test-adapter-path $testadapterpath --logger ""xunit;LogFilePath=$testLogPath"" /bl:$testBinLogPath" + $targetName = [System.IO.Path]::GetFileNameWithoutExtension($path) + $testLogPath = "$ArtifactsDir\TestResults\$configuration\{assembly}_{framework}.xml" + $testBinLogPath = "$LogDir\${targetName}_$targetFramework.binlog" + $arguments = "test $path -c $configuration -f $targetFramework -v n --test-adapter-path $testadapterpath --logger ""xunit;LogFilePath=$testLogPath"" /bl:$testBinLogPath" $arguments += " --blame --blame-hang-timeout 5minutes --results-directory $ArtifactsDir\TestResults\$configuration -p:vstestusemsbuildoutput=true" if (-not $noVisualStudio -or $norestore) { @@ -382,7 +381,7 @@ function TestUsingMSBuild([string] $testProject, [string] $targetFramework, [str $arguments += " $settings" - if ($backgroundJob) { + if ($asBackgroundJob) { Write-Host Write-Host("Starting on the background: $arguments") Write-Host("------------------------------------") @@ -399,47 +398,6 @@ function TestUsingMSBuild([string] $testProject, [string] $targetFramework, [str } } -function TestSolutionUsingMSBuild([string] $testSolution, [string] $targetFramework, [string] $testadapterpath, [string] $backgroundJob = "", [string] $settings = "") { - $jobId = if ($backgroundJob) { "_$backgroundJob"} else {""} - $dotnetPath = InitializeDotNetCli - $dotnetExe = Join-Path $dotnetPath "dotnet.exe" - $solutionName = [System.IO.Path]::GetFileNameWithoutExtension($testSolution) - $testLogPath = "$ArtifactsDir\TestResults\$configuration\{assembly}.{framework}$jobId.xml" - $testBinLogPath = "$LogDir\${solutionName}_$targetFramework$jobId.binlog" - - $arguments = "test" - - $arguments += " $testSolution -c $configuration -f $targetFramework --test-adapter-path $testadapterpath -v n --logger ""xunit;LogFilePath=$testLogPath"" /bl:$testBinLogPath" - $arguments += " --blame-hang-timeout 5minutes --results-directory $ArtifactsDir\TestResults\$configuration /p:VsTestUseMSBuildOutput=true" - - if (-not $noVisualStudio -or $norestore) { - $arguments += " --no-restore" - } - - if (-not $noVisualStudio) { - $arguments += " --no-build" - } - - $arguments += " $settings" - - if ($backgroundJob) { - Write-Host - Write-Host("Starting on the background: $arguments") - Write-Host("------------------------------------") - Start-Job -ScriptBlock { - $argArray = $using:arguments -Split " " - $argArray += "--no-build" - & $using:dotnetExe $argArray - if ($LASTEXITCODE -ne 0) { - throw "Command failed to execute with exit code $($LASTEXITCODE): $using:dotnetExe $using:args" - } - } - } else { - Write-Host("$arguments") - Exec-Console $dotnetExe $arguments - } -} - function Prepare-TempDir() { Copy-Item (Join-Path $RepoRoot "tests\Resources\Directory.Build.props") $TempDir Copy-Item (Join-Path $RepoRoot "tests\Resources\Directory.Build.targets") $TempDir @@ -643,17 +601,17 @@ try { if ($testCoreClr) { $cpuLimit = if ($ci) { "-m:2 -- xUnit.MaxParallelThreads=0.25x" } else { "" } - TestSolutionUsingMSBuild -testSolution "$RepoRoot\FSharp.sln" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -settings $cpuLimit + TestUsingMSBuild -path "$RepoRoot\FSharp.sln" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" -settings $cpuLimit } if ($testDesktop) { - $bgJob = TestUsingMSBuild -testProject "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" -backgroundJob 1 + $bgJob = TestUsingMSBuild -path "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" -asBackgroundJob $true - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Service.Tests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Private.Scripting.UnitTests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Build.UnitTests\FSharp.Build.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Build.UnitTests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Core.UnitTests\FSharp.Core.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Core.UnitTests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Service.Tests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Private.Scripting.UnitTests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Build.UnitTests\FSharp.Build.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Build.UnitTests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Core.UnitTests\FSharp.Core.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Core.UnitTests\" Receive -job $bgJob } @@ -686,50 +644,50 @@ try { } if ($testFSharpCore) { - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Core.UnitTests\FSharp.Core.UnitTests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Core.UnitTests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Core.UnitTests\FSharp.Core.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Core.UnitTests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Core.UnitTests\FSharp.Core.UnitTests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Core.UnitTests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Core.UnitTests\FSharp.Core.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Core.UnitTests\" } if ($testCompiler) { - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Service.Tests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Service.Tests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Service.Tests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Service.Tests\" } if ($testCompilerComponentTests) { - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Compiler.ComponentTests\FSharp.Compiler.ComponentTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.ComponentTests\" } if ($testCompilerService) { - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Service.Tests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Service.Tests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Service.Tests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Compiler.Service.Tests\FSharp.Compiler.Service.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Service.Tests\" } if ($testCambridge) { - TestUsingMSBuild -testProject "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" + TestUsingMSBuild -path "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" + TestUsingMSBuild -path "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" } if ($testScripting) { - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Private.Scripting.UnitTests\" - TestUsingMSBuild -testProject "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Private.Scripting.UnitTests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Private.Scripting.UnitTests\" + TestUsingMSBuild -path "$RepoRoot\tests\FSharp.Compiler.Private.Scripting.UnitTests\FSharp.Compiler.Private.Scripting.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Compiler.Private.Scripting.UnitTests\" } if ($testEditor -and -not $noVisualStudio) { - TestUsingMSBuild -testProject "$RepoRoot\vsintegration\tests\FSharp.Editor.Tests\FSharp.Editor.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Editor.Tests\FSharp.Editor.Tests.fsproj" + TestUsingMSBuild -path "$RepoRoot\vsintegration\tests\FSharp.Editor.Tests\FSharp.Editor.Tests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Editor.Tests\FSharp.Editor.Tests.fsproj" } if ($testVs -and -not $noVisualStudio) { - TestUsingMSBuild -testProject "$RepoRoot\vsintegration\tests\UnitTests\VisualFSharp.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\VisualFSharp.UnitTests\" + TestUsingMSBuild -path "$RepoRoot\vsintegration\tests\UnitTests\VisualFSharp.UnitTests.fsproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\VisualFSharp.UnitTests\" } if ($testIntegration) { - TestUsingMSBuild -testProject "$RepoRoot\vsintegration\tests\FSharp.Editor.IntegrationTests\FSharp.Editor.IntegrationTests.csproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Editor.IntegrationTests\" + TestUsingMSBuild -path "$RepoRoot\vsintegration\tests\FSharp.Editor.IntegrationTests\FSharp.Editor.IntegrationTests.csproj" -targetFramework $script:desktopTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharp.Editor.IntegrationTests\" } if ($testAOT) { diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index b8b5eedeb73..5558589351a 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -378,7 +378,7 @@ type AsyncModule() = [] member _.``AwaitWaitHandle.DisposedWaitHandle2``() = - let wh = new System.Threading.ManualResetEvent(false) + let wh = new ManualResetEvent(false) let started = new ManualResetEventSlim(false) let cts = new CancellationTokenSource() let test = diff --git a/tests/FSharp.Test.Utilities/ScriptHelpers.fs b/tests/FSharp.Test.Utilities/ScriptHelpers.fs index 9ed9717d352..aa0593fa090 100644 --- a/tests/FSharp.Test.Utilities/ScriptHelpers.fs +++ b/tests/FSharp.Test.Utilities/ScriptHelpers.fs @@ -24,9 +24,7 @@ type LangVersion = | Latest | SupportsMl -type FSharpScript(?additionalArgs: string[], ?quiet: bool, ?langVersion: LangVersion, ?input: string) = - - do ignore input +type FSharpScript(?additionalArgs: string[], ?quiet: bool, ?langVersion: LangVersion) = let additionalArgs = defaultArg additionalArgs [||] let quiet = defaultArg quiet true From e665e7910e136ef0849caafa76015f42b751c459 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 28 Oct 2024 12:04:04 +0100 Subject: [PATCH 6/8] try fix test --- .../FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index 5558589351a..8c5a7d4871c 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -474,8 +474,8 @@ type AsyncModule() = let mutable running = new CountdownEvent(1) let job i = async { - running.AddCount 1 use! holder = Async.OnCancel (running.Signal >> ignore) + running.AddCount 1 do! failOnlyOne |> Async.AwaitWaitHandle |> Async.Ignore running.Signal() |> ignore failwith "boom" From efc4c2828f7a62eaff7fb1bd863dfb2df8ddcc38 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 28 Oct 2024 18:21:09 +0100 Subject: [PATCH 7/8] lazy pattern --- tests/FSharp.Test.Utilities/ProjectGeneration.fs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/tests/FSharp.Test.Utilities/ProjectGeneration.fs b/tests/FSharp.Test.Utilities/ProjectGeneration.fs index 0dd94d35236..c55a4afcd1b 100644 --- a/tests/FSharp.Test.Utilities/ProjectGeneration.fs +++ b/tests/FSharp.Test.Utilities/ProjectGeneration.fs @@ -226,7 +226,7 @@ let sourceFile fileId deps = IsPhysicalFile = false } -let OptionsCache = ConcurrentDictionary<_, FSharpProjectOptions>() +let OptionsCache = ConcurrentDictionary<_, Lazy<_>>() type SyntheticProject = @@ -306,6 +306,7 @@ type SyntheticProject = this.NugetReferences let factory _ = + lazy use _ = Activity.start "SyntheticProject.GetProjectOptions" [ "project", this.Name ] let referenceScript = @@ -352,7 +353,7 @@ type SyntheticProject = Stamp = None } - OptionsCache.GetOrAdd(key, factory) + OptionsCache.GetOrAdd(key, factory).Value member this.GetAllProjects() = From 1b0073179479ab4c9e20e6fadca809476a803c62 Mon Sep 17 00:00:00 2001 From: Jakub Majocha <1760221+majocha@users.noreply.github.com> Date: Mon, 28 Oct 2024 18:21:33 +0100 Subject: [PATCH 8/8] reenable extras --- tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj index 3abb34d3c2c..d0afb09fa18 100644 --- a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj +++ b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj @@ -14,7 +14,7 @@ $(OtherFlags) --warnon:1182 true - + XUNIT_EXTRAS