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 01/21] 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 02/21] 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 03/21] 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 04/21] 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 05/21] 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 06/21] 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 07/21] 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 08/21] 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
From 8f82c8d93cc9761d70891a9d0d079470f2a5f2d1 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Mon, 28 Oct 2024 18:23:29 +0100
Subject: [PATCH 09/21] process graph with Async.Parallel
---
.../Driver/GraphChecking/GraphProcessing.fs | 59 ++++---------------
1 file changed, 10 insertions(+), 49 deletions(-)
diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs
index 33dd1c42c46..7f624ef90b5 100644
--- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs
+++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs
@@ -176,15 +176,6 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison>
async {
let transitiveDeps = graph |> Graph.transitive
let dependents = graph |> Graph.reverse
- // Cancellation source used to signal either an exception in one of the items or end of processing.
- let! parentCt = Async.CancellationToken
- use localCts = new CancellationTokenSource()
-
- let completionSignal = TaskCompletionSource()
-
- use _ = parentCt.Register(fun () -> completionSignal.TrySetCanceled() |> ignore)
-
- use cts = CancellationTokenSource.CreateLinkedTokenSource(parentCt, localCts.Token)
let makeNode (item: 'Item) : GraphNode<'Item, 'Result> =
let info =
@@ -228,43 +219,16 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison>
|> Option.defaultWith (fun () -> failwith $"Results for item '{node.Info.Item}' are not yet available")
}
- let processedCount = IncrementableInt(0)
-
- let handleExn (item, ex: exn) =
- try
- localCts.Cancel()
- with :? ObjectDisposedException ->
- // If it's disposed already, it means that the processing has already finished, most likely due to cancellation or failure in another node.
- ()
-
- match ex with
- | :? OperationCanceledException -> completionSignal.TrySetCanceled()
- | _ ->
- completionSignal.TrySetException(
- GraphProcessingException($"[*] Encountered exception when processing item '{item}': {ex.Message}", ex)
- )
- |> ignore
-
- let incrementProcessedNodesCount () =
- if processedCount.Increment() = nodes.Count then
- completionSignal.TrySetResult() |> ignore
-
let rec queueNode node =
- Async.Start(
- async {
- use! _catch = Async.OnCancel(completionSignal.TrySetCanceled >> ignore)
- let! res = processNode node |> Async.Catch
-
- match res with
- | Choice1Of2() -> ()
- | Choice2Of2 ex -> handleExn (node.Info.Item, ex)
- },
- cts.Token
- )
-
- and processNode (node: GraphNode<'Item, 'Result>) : Async =
async {
+ try
+ do! processNode node
+ with
+ | ex -> return raise (GraphProcessingException($"[*] Encountered exception when processing item '{node.Info.Item}': {ex.Message}", ex))
+ }
+ and processNode (node: GraphNode<'Item, 'Result>) =
+ async {
let info = node.Info
let! singleRes = work getItemPublicNode info
@@ -280,14 +244,11 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison>
// Note: We cannot read 'dependent.ProcessedDepsCount' again to avoid returning the same item multiple times.
pdc = dependent.Info.Deps.Length)
- unblockedDependents |> Array.iter queueNode
- incrementProcessedNodesCount ()
+
+ do! unblockedDependents |> Array.map queueNode |> Async.Parallel |> Async.Ignore
}
- leaves |> Array.iter queueNode
-
- // Wait for end of processing, an exception, or an external cancellation request.
- do! completionSignal.Task |> Async.AwaitTask
+ do! leaves |> Array.map queueNode |> Async.Parallel |> Async.Ignore
// All calculations succeeded - extract the results and sort in input order.
return
From c8567d3cceacf626c0b04b273e1eb5c9376a09c2 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Mon, 28 Oct 2024 18:24:11 +0100
Subject: [PATCH 10/21] reenable transparent compiler tests
---
.../FSharpChecker/TransparentCompiler.fs | 63 +++++++++----------
.../BuildGraphTests.fs | 2 +-
.../MultiProjectAnalysisTests.fs | 2 +-
.../ProjectAnalysisTests.fs | 16 ++---
4 files changed, 40 insertions(+), 43 deletions(-)
diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs
index 8bc9ac09f05..8c9e020c8fb 100644
--- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs
+++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs
@@ -30,7 +30,7 @@ open OpenTelemetry.Trace
#nowarn "57"
-[]
+[]
let ``Use Transparent Compiler`` () =
let size = 20
@@ -60,7 +60,7 @@ let ``Use Transparent Compiler`` () =
checkFile last expectSignatureChanged
}
-[]
+[]
let ``Parallel processing`` () =
let project = SyntheticProject.Create(
@@ -78,7 +78,7 @@ let ``Parallel processing`` () =
checkFile "E" expectSignatureChanged
}
-[]
+[]
let ``Parallel processing with signatures`` () =
let project = SyntheticProject.Create(
@@ -113,7 +113,7 @@ let makeTestProject () =
let testWorkflow () =
ProjectWorkflowBuilder(makeTestProject(), useTransparentCompiler = true)
-[]
+[]
let ``Edit file, check it, then check dependent file`` () =
testWorkflow() {
updateFile "First" breakDependentFiles
@@ -121,21 +121,21 @@ let ``Edit file, check it, then check dependent file`` () =
checkFile "Second" expectErrors
}
-[]
+[]
let ``Edit file, don't check it, check dependent file`` () =
testWorkflow() {
updateFile "First" breakDependentFiles
checkFile "Second" expectErrors
}
-[]
+[]
let ``Check transitive dependency`` () =
testWorkflow() {
updateFile "First" breakDependentFiles
checkFile "Last" expectSignatureChanged
}
-[]
+[]
let ``Change multiple files at once`` () =
testWorkflow() {
updateFile "First" (setPublicVersion 2)
@@ -144,7 +144,7 @@ let ``Change multiple files at once`` () =
checkFile "Last" (expectSignatureContains "val f: x: 'a -> (ModuleFirst.TFirstV_2<'a> * ModuleSecond.TSecondV_2<'a>) * (ModuleFirst.TFirstV_2<'a> * ModuleThird.TThirdV_2<'a>) * TLastV_1<'a>")
}
-[]
+[]
let ``Files depend on signature file if present`` () =
let project = makeTestProject() |> updateFile "First" addSignatureFile
@@ -154,7 +154,7 @@ let ``Files depend on signature file if present`` () =
checkFile "Second" expectNoChanges
}
-[]
+[]
let ``Project with signatures`` () =
let project = SyntheticProject.Create(
@@ -169,7 +169,7 @@ let ``Project with signatures`` () =
checkFile "Second" expectOk
}
-[]
+[]
let ``Signature update`` () =
let project = SyntheticProject.Create(
@@ -185,7 +185,7 @@ let ``Signature update`` () =
checkFile "Second" expectSignatureChanged
}
-[]
+[]
let ``Adding a file`` () =
testWorkflow() {
addFileAbove "Second" (sourceFile "New" [])
@@ -193,14 +193,14 @@ let ``Adding a file`` () =
checkFile "Last" (expectSignatureContains "val f: x: 'a -> (ModuleFirst.TFirstV_1<'a> * ModuleNew.TNewV_1<'a> * ModuleSecond.TSecondV_1<'a>) * (ModuleFirst.TFirstV_1<'a> * ModuleThird.TThirdV_1<'a>) * TLastV_1<'a>")
}
-[]
+[]
let ``Removing a file`` () =
testWorkflow() {
removeFile "Second"
checkFile "Last" expectErrors
}
-[]
+[]
let ``Changes in a referenced project`` () =
let library = SyntheticProject.Create("library", sourceFile "Library" [])
@@ -219,7 +219,7 @@ let ``Changes in a referenced project`` () =
}
-[]
+[]
let ``File is not checked twice`` () =
let cacheEvents = ConcurrentQueue()
@@ -243,7 +243,7 @@ let ``File is not checked twice`` () =
Assert.Equal([Weakened; Requested; Started; Finished], intermediateTypeChecks["FileFirst.fs"])
Assert.Equal([Weakened; Requested; Started; Finished], intermediateTypeChecks["FileThird.fs"])
-[]
+[]
let ``If a file is checked as a dependency it's not re-checked later`` () =
let cacheEvents = ConcurrentQueue()
@@ -267,7 +267,7 @@ let ``If a file is checked as a dependency it's not re-checked later`` () =
Assert.Equal([Weakened; Requested; Started; Finished; Requested], intermediateTypeChecks["FileThird.fs"])
-// [] TODO: differentiate complete and minimal checking requests
+// [] TODO: differentiate complete and minimal checking requests
let ``We don't check files that are not depended on`` () =
let project = SyntheticProject.Create(
sourceFile "First" [],
@@ -297,7 +297,7 @@ let ``We don't check files that are not depended on`` () =
Assert.Equal([Started; Finished], intermediateTypeChecks["FileThird.fs"])
Assert.False (intermediateTypeChecks.ContainsKey "FileSecond.fs")
-// [] TODO: differentiate complete and minimal checking requests
+// [] TODO: differentiate complete and minimal checking requests
let ``Files that are not depended on don't invalidate cache`` () =
let project = SyntheticProject.Create(
sourceFile "First" [],
@@ -338,7 +338,7 @@ let ``Files that are not depended on don't invalidate cache`` () =
Assert.Equal([], intermediateTypeChecks |> Map.toList)
-// [] TODO: differentiate complete and minimal checking requests
+// [] TODO: differentiate complete and minimal checking requests
let ``Files that are not depended on don't invalidate cache part 2`` () =
let project = SyntheticProject.Create(
sourceFile "A" [],
@@ -378,7 +378,7 @@ let ``Files that are not depended on don't invalidate cache part 2`` () =
Assert.Equal(["FileE.fs", [Started; Finished]], graphConstructions)
Assert.Equal(["FileE.fs", [Started; Finished]], intermediateTypeChecks)
-[]
+[]
let ``Changing impl files doesn't invalidate cache when they have signatures`` () =
let project = SyntheticProject.Create(
{ sourceFile "A" [] with SignatureFile = AutoGenerated },
@@ -407,7 +407,7 @@ let ``Changing impl files doesn't invalidate cache when they have signatures`` (
Assert.Equal([], intermediateTypeChecks)
-[]
+[]
let ``Changing impl file doesn't invalidate an in-memory referenced project`` () =
let library = SyntheticProject.Create("library", { sourceFile "A" [] with SignatureFile = AutoGenerated })
@@ -646,13 +646,10 @@ let fuzzingTest seed (project: SyntheticProject) = task {
builder.DeleteProjectDir()
}
-
-(* This gets in the way of insertions too often now, uncomment when stable.
[]
[]
[]
[]
-*)
let Fuzzing signatureFiles =
let seed = System.Random().Next()
@@ -790,7 +787,7 @@ module Stuff =
let fileName, snapshot, checker = singleFileChecker source
checker.ParseFile(fileName, snapshot) |> Async.RunSynchronously
- //[]
+ //[]
let ``Hash stays the same when whitespace changes`` () =
//let parseResult = getParseResult source
@@ -846,7 +843,7 @@ let ``TypeCheck last file in project with transparent compiler`` useTransparentC
checkFile lastFile expectOk
}
-[]
+[]
let ``LoadClosure for script is computed once`` () =
let project = SyntheticProject.CreateForScript(
sourceFile "First" [])
@@ -871,7 +868,7 @@ let ``LoadClosure for script is computed once`` () =
Assert.Empty(closureComputations)
-[]
+[]
let ``LoadClosure for script is recomputed after changes`` () =
let project = SyntheticProject.CreateForScript(
sourceFile "First" [])
@@ -900,7 +897,7 @@ let ``LoadClosure for script is recomputed after changes`` () =
Assert.Equal([Weakened; Requested; Started; Finished; Weakened; Requested; Started; Finished], closureComputations["FileFirst.fs"])
-[]
+[]
let ``TryGetRecentCheckResultsForFile returns None before first call to ParseAndCheckFileInProject`` () =
let project = SyntheticProject.Create(
sourceFile "First" [])
@@ -910,7 +907,7 @@ let ``TryGetRecentCheckResultsForFile returns None before first call to ParseAnd
tryGetRecentCheckResults "First" expectNone
} |> ignore
-[]
+[]
let ``TryGetRecentCheckResultsForFile returns result after first call to ParseAndCheckFileInProject`` () =
let project = SyntheticProject.Create(
sourceFile "First" [] )
@@ -919,7 +916,7 @@ let ``TryGetRecentCheckResultsForFile returns result after first call to ParseAn
tryGetRecentCheckResults "First" expectSome
} |> ignore
-[]
+[]
let ``TryGetRecentCheckResultsForFile returns no result after edit`` () =
let project = SyntheticProject.Create(
sourceFile "First" [])
@@ -932,7 +929,7 @@ let ``TryGetRecentCheckResultsForFile returns no result after edit`` () =
tryGetRecentCheckResults "First" expectSome
} |> ignore
-[]
+[]
let ``TryGetRecentCheckResultsForFile returns result after edit of other file`` () =
let project = SyntheticProject.Create(
sourceFile "First" [],
@@ -946,9 +943,9 @@ let ``TryGetRecentCheckResultsForFile returns result after edit of other file``
tryGetRecentCheckResults "Second" expectSome // file didn't change so we still want to get the recent result
} |> ignore
-[]
+[]
let ``Background compiler and Transparent compiler return the same options`` () =
- async {
+ task {
let backgroundChecker = FSharpChecker.Create(useTransparentCompiler = false)
let transparentChecker = FSharpChecker.Create(useTransparentCompiler = true)
let scriptName = Path.Combine(__SOURCE_DIRECTORY__, "script.fsx")
@@ -1013,7 +1010,7 @@ printfn "Hello from F#"
checkFile "As 01" expectTwoWarnings
}
-[]
+[]
let ``Transparent Compiler ScriptClosure cache is populated after GetProjectOptionsFromScript`` () =
async {
let transparentChecker = FSharpChecker.Create(useTransparentCompiler = true)
diff --git a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs
index 4769b4c322d..c87f2926e74 100644
--- a/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/BuildGraphTests.fs
@@ -183,7 +183,7 @@ module BuildGraphTests =
Assert.shouldBeTrue(ex <> null)
try task.Wait(1000) |> ignore with | :? TimeoutException -> reraise() | _ -> ()
- []
+ []
let ``Many requests to get a value asynchronously might evaluate the computation more than once even when some requests get canceled``() =
let requests = 10000
let resetEvent = new ManualResetEvent(false)
diff --git a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
index 3564288b229..22c17f48871 100644
--- a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
@@ -444,7 +444,7 @@ let z = Project1.x
ReferencedProjects = [| FSharpReferencedProject.FSharpReference(MultiProjectDirty1.dllName, MultiProjectDirty1.getOptions()) |] }
[]
-// []
+[]
[]
let ``Test multi project symbols should pick up changes in dependent projects`` useTransparentCompiler =
diff --git a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs
index 807fa90c78c..b52435e54a5 100644
--- a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs
@@ -4647,7 +4647,7 @@ let callToOverload = B(5).Overload(4)
let args = mkProjectCommandLineArgs (dllName, [])
[]
-// [] // Flaky, reenable when stable
+[] // Flaky, reenable when stable
[]
let ``Test project36 FSharpMemberOrFunctionOrValue.IsBaseValue`` useTransparentCompiler =
let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true, useTransparentCompiler=useTransparentCompiler)
@@ -4664,7 +4664,7 @@ let ``Test project36 FSharpMemberOrFunctionOrValue.IsBaseValue`` useTransparentC
|> fun baseSymbol -> shouldEqual true baseSymbol.IsBaseValue
[]
-// [] // Flaky, reenable when stable
+[] // Flaky, reenable when stable
[]
let ``Test project36 FSharpMemberOrFunctionOrValue.IsConstructorThisValue & IsMemberThisValue`` useTransparentCompiler =
let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true, useTransparentCompiler=useTransparentCompiler)
@@ -4703,7 +4703,7 @@ let ``Test project36 FSharpMemberOrFunctionOrValue.IsConstructorThisValue & IsMe
|> shouldEqual true
[]
-// [] // Flaky, reenable when stable
+[] // Flaky, reenable when stable
[]
let ``Test project36 FSharpMemberOrFunctionOrValue.LiteralValue`` useTransparentCompiler =
let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true, useTransparentCompiler=useTransparentCompiler)
@@ -5324,7 +5324,7 @@ let foo (a: Foo): bool =
let options = { checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) with SourceFiles = fileNames }
[]
-// [] // Flaky, reenable when stable
+[] // Flaky, reenable when stable
[]
let ``Test typed AST for struct unions`` useTransparentCompiler = // See https://github.com/fsharp/FSharp.Compiler.Service/issues/756
let keepAssemblyContentsChecker = FSharpChecker.Create(keepAssemblyContents=true, useTransparentCompiler=useTransparentCompiler)
@@ -5414,7 +5414,7 @@ let ``Test diagnostics with line directives ignored`` () =
//------------------------------------------------------
[]
-// [] // Flaky, reenable when stable
+[] // Flaky, reenable when stable
[]
let ``ParseAndCheckFileResults contains ImplFile list if FSharpChecker is created with keepAssemblyContent flag set to true`` useTransparentCompiler =
@@ -5500,7 +5500,7 @@ let ``#4030, Incremental builder creation warnings 5`` () =
//------------------------------------------------------
[]
-// [] // Flaky, reenable when stable
+[] // Flaky, reenable when stable
[]
let ``Unused opens in rec module smoke test 1`` useTransparentCompiler =
@@ -5575,7 +5575,7 @@ type UseTheThings(i:int) =
unusedOpensData |> shouldEqual expected
[]
-// [] // Flaky, reenable when stable
+[] // Flaky, reenable when stable
[]
let ``Unused opens in non rec module smoke test 1`` useTransparentCompiler =
@@ -5664,7 +5664,7 @@ type UseTheThings(i:int) =
unusedOpensData |> shouldEqual expected
[]
-// [] // Flaky, reenable when stable
+[] // Flaky, reenable when stable
[]
let ``Unused opens smoke test auto open`` useTransparentCompiler =
From dc139f43bc48841d50692a885859047f07a1e2e3 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Mon, 28 Oct 2024 20:39:10 +0100
Subject: [PATCH 11/21] service tests had parallel disabled
---
tests/FSharp.Compiler.Service.Tests/AssemblyInfo.fs | 7 -------
.../FSharp.Compiler.Service.Tests.fsproj | 1 -
.../MultiProjectAnalysisTests.fs | 3 ++-
.../FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs | 6 ++++--
tests/FSharp.Test.Utilities/XunitHelpers.fs | 6 +++---
5 files changed, 9 insertions(+), 14 deletions(-)
delete mode 100644 tests/FSharp.Compiler.Service.Tests/AssemblyInfo.fs
diff --git a/tests/FSharp.Compiler.Service.Tests/AssemblyInfo.fs b/tests/FSharp.Compiler.Service.Tests/AssemblyInfo.fs
deleted file mode 100644
index 3433f928ba4..00000000000
--- a/tests/FSharp.Compiler.Service.Tests/AssemblyInfo.fs
+++ /dev/null
@@ -1,7 +0,0 @@
-module FSharp.Compiler.Service.Tests.AssemblyInfo
-
-open Xunit
-
-[]
-
-do()
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 831143ba698..59094ee50da 100644
--- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj
+++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj
@@ -19,7 +19,6 @@
Never
-
FsUnit.fs
diff --git a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
index 3564288b229..ae8197f3389 100644
--- a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
@@ -448,7 +448,8 @@ let z = Project1.x
[]
let ``Test multi project symbols should pick up changes in dependent projects`` useTransparentCompiler =
- let checker = if useTransparentCompiler then transparentCompilerChecker else checker
+ // A private checker because we subscribe to FileChecked.
+ let checker = FSharpChecker.Create(useTransparentCompiler = useTransparentCompiler)
// register to count the file checks
let count = ref 0
diff --git a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs
index 807fa90c78c..74737391e56 100644
--- a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs
@@ -1,6 +1,7 @@
module FSharp.Compiler.Service.Tests.ProjectAnalysisTests
#nowarn "57" // Experimental stuff
+open FSharp.Compiler.CodeAnalysis
let runningOnMono = try System.Type.GetType("Mono.Runtime") <> null with e -> false
@@ -19,8 +20,6 @@ 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")
@@ -110,6 +109,9 @@ let ``Test project1 whole project errors`` () =
[]
let ``Test project1 and make sure TcImports gets cleaned up`` () =
+ // A private checker for this test.
+ let checker = FSharpChecker.Create(useTransparentCompiler = FSharp.Test.TestContext.UseTransparentCompiler)
+
let test () =
let _, checkFileAnswer = checker.ParseAndCheckFileInProject(Project1.fileName1, 0, Project1.fileSource1, Project1.options) |> Async.RunImmediate
match checkFileAnswer with
diff --git a/tests/FSharp.Test.Utilities/XunitHelpers.fs b/tests/FSharp.Test.Utilities/XunitHelpers.fs
index 07c3dd3df5c..72d6c40aa8a 100644
--- a/tests/FSharp.Test.Utilities/XunitHelpers.fs
+++ b/tests/FSharp.Test.Utilities/XunitHelpers.fs
@@ -14,14 +14,14 @@ open Xunit.Abstractions
type RunInSequenceAttribute() = inherit Attribute()
#if !XUNIT_EXTRAS
-/// Installs console support for parallel test runs and conditionally enables optional xUnit customizations.
+/// Installs console support for parallel test runs.
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
+ log "FSharpXunitFramework installing TestConsole redirection"
TestConsole.install()
#else
@@ -129,7 +129,7 @@ type FSharpXunitFramework(sink: IMessageSink) =
// 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
+ log "FSharpXunitFramework with XUNIT_EXTRAS installing TestConsole redirection"
TestConsole.install()
override this.CreateDiscoverer (assemblyInfo) =
From 17964e553beaef3840ef1667398deb287b057142 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Tue, 29 Oct 2024 08:33:26 +0100
Subject: [PATCH 12/21] improve
---
.../MultiProjectAnalysisTests.fs | 26 ++++++++++---------
1 file changed, 14 insertions(+), 12 deletions(-)
diff --git a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
index ef753a6bc3e..e0cb635633f 100644
--- a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
@@ -452,8 +452,9 @@ let ``Test multi project symbols should pick up changes in dependent projects``
let checker = FSharpChecker.Create(useTransparentCompiler = useTransparentCompiler)
// register to count the file checks
- let count = ref 0
- checker.FileChecked.Add (fun _ -> incr count)
+ let mutable count = 0
+ let waitForCount n = System.Threading.SpinWait.SpinUntil(fun () -> count = n)
+ checker.FileChecked.Add (fun _ -> System.Threading.Interlocked.Increment &count |> ignore)
//---------------- Write the first version of the file in project 1 and check the project --------------------
@@ -461,13 +462,13 @@ let ``Test multi project symbols should pick up changes in dependent projects``
let wholeProjectResults1 = checker.ParseAndCheckProject(proj1options) |> Async.RunImmediate
- count.Value |> shouldEqual 1
+ count |> shouldEqual 1
let backgroundParseResults1, backgroundTypedParse1 =
checker.GetBackgroundCheckResultsForFileInProject(MultiProjectDirty1.fileName1, proj1options)
|> Async.RunImmediate
- count.Value |> shouldEqual 1
+ count |> shouldEqual 1
//---------------- Get a symbol from project 1 and look up its uses in both projects --------------------
@@ -481,11 +482,11 @@ let ``Test multi project symbols should pick up changes in dependent projects``
let wholeProjectResults2 = checker.ParseAndCheckProject(proj2options) |> Async.RunImmediate
- count.Value |> shouldEqual 2
+ count |> shouldEqual 2
let _ = checker.ParseAndCheckProject(proj2options) |> Async.RunImmediate
- count.Value |> shouldEqual 2 // cached
+ count |> shouldEqual 2 // cached
let usesOfXSymbolInProject1 =
wholeProjectResults1.GetUsesOfSymbol(xSymbol)
@@ -519,7 +520,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
printfn "New write time: '%A', ticks = %d" wt2 wt2.Ticks
let wholeProjectResults1AfterChange1 = checker.ParseAndCheckProject(proj1options) |> Async.RunImmediate
- count.Value |> shouldEqual 3
+ count |> shouldEqual 3
let backgroundParseResults1AfterChange1, backgroundTypedParse1AfterChange1 =
checker.GetBackgroundCheckResultsForFileInProject(MultiProjectDirty1.fileName1, proj1options)
@@ -534,7 +535,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
let wholeProjectResults2AfterChange1 = checker.ParseAndCheckProject(proj2options) |> Async.RunImmediate
- count.Value |> shouldEqual 4
+ count |> shouldEqual 4
let usesOfXSymbolInProject1AfterChange1 =
wholeProjectResults1AfterChange1.GetUsesOfSymbol(xSymbolAfterChange1)
@@ -566,16 +567,17 @@ let ``Test multi project symbols should pick up changes in dependent projects``
printfn "Old write time: '%A', ticks = %d" wt1b wt1b.Ticks
printfn "New write time: '%A', ticks = %d" wt2b wt2b.Ticks
- count.Value |> shouldEqual 4
+ count |> shouldEqual 4
let wholeProjectResults2AfterChange2 = checker.ParseAndCheckProject(proj2options) |> Async.RunImmediate
System.Threading.Thread.Sleep(1000)
- count.Value |> shouldEqual 6 // note, causes two files to be type checked, one from each project
+ waitForCount 6
+ count |> shouldEqual 6 // note, causes two files to be type checked, one from each project
let wholeProjectResults1AfterChange2 = checker.ParseAndCheckProject(proj1options) |> Async.RunImmediate
- count.Value |> shouldEqual 6 // the project is already checked
+ count |> shouldEqual 6 // the project is already checked
let backgroundParseResults1AfterChange2, backgroundTypedParse1AfterChange2 =
checker.GetBackgroundCheckResultsForFileInProject(MultiProjectDirty1.fileName1, proj1options)
@@ -830,7 +832,7 @@ let ``Test active patterns' XmlDocSig declared in referenced projects`` useTrans
//------------------------------------------------------------------------------------
-
+[]
[]
[]
[]
From 8d6290e37955743218bc136cfb907dd7c7eef016 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Tue, 29 Oct 2024 09:31:28 +0100
Subject: [PATCH 13/21] exclude perf test
---
tests/FSharp.Compiler.Service.Tests/PerfTests.fs | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/tests/FSharp.Compiler.Service.Tests/PerfTests.fs b/tests/FSharp.Compiler.Service.Tests/PerfTests.fs
index 0a58bd4ec72..8a417cec07c 100644
--- a/tests/FSharp.Compiler.Service.Tests/PerfTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/PerfTests.fs
@@ -1,4 +1,6 @@
-module FSharp.Compiler.Service.Tests.PerfTests
+// Because of global static FSharpChecker.ActualCheckFileCount
+[]
+module FSharp.Compiler.Service.Tests.PerfTests
open Xunit
open FsUnit
From 323ebede0fac60cd6e99f21e592a41474c6d32b9 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Tue, 29 Oct 2024 09:31:53 +0100
Subject: [PATCH 14/21] format
---
src/Compiler/Driver/GraphChecking/GraphProcessing.fs | 10 ++++++----
1 file changed, 6 insertions(+), 4 deletions(-)
diff --git a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs
index 7f624ef90b5..37d7428991d 100644
--- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs
+++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs
@@ -221,10 +221,13 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison>
let rec queueNode node =
async {
- try
+ try
do! processNode node
- with
- | ex -> return raise (GraphProcessingException($"[*] Encountered exception when processing item '{node.Info.Item}': {ex.Message}", ex))
+ with ex ->
+ return
+ raise (
+ GraphProcessingException($"[*] Encountered exception when processing item '{node.Info.Item}': {ex.Message}", ex)
+ )
}
and processNode (node: GraphNode<'Item, 'Result>) =
@@ -244,7 +247,6 @@ let processGraphAsync<'Item, 'Result when 'Item: equality and 'Item: comparison>
// Note: We cannot read 'dependent.ProcessedDepsCount' again to avoid returning the same item multiple times.
pdc = dependent.Info.Deps.Length)
-
do! unblockedDependents |> Array.map queueNode |> Async.Parallel |> Async.Ignore
}
From 0ffca1f3a0f49e96691a4592e2eac639a7a31c4b Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Tue, 29 Oct 2024 10:06:46 +0100
Subject: [PATCH 15/21] wip
---
.../MultiProjectAnalysisTests.fs | 11 +++++++++--
1 file changed, 9 insertions(+), 2 deletions(-)
diff --git a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
index e0cb635633f..8d8471cbae3 100644
--- a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
@@ -1,4 +1,7 @@
-module FSharp.Compiler.Service.Tests.MultiProjectAnalysisTests
+// Because of shared physical files
+// TODO: make the test cases independent
+[]
+module FSharp.Compiler.Service.Tests.MultiProjectAnalysisTests
open Xunit
open FsUnit
@@ -453,7 +456,11 @@ let ``Test multi project symbols should pick up changes in dependent projects``
// register to count the file checks
let mutable count = 0
- let waitForCount n = System.Threading.SpinWait.SpinUntil(fun () -> count = n)
+
+ let waitForCount n =
+ if count > n then failwith $"checks count {count}, expected {n}"
+ System.Threading.SpinWait.SpinUntil(fun () -> count = n)
+
checker.FileChecked.Add (fun _ -> System.Threading.Interlocked.Increment &count |> ignore)
//---------------- Write the first version of the file in project 1 and check the project --------------------
From 40296d999fea34a8b17d341ee2932fd0d0d1b67f Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Tue, 29 Oct 2024 10:53:05 +0100
Subject: [PATCH 16/21] disable one problematic case pending investigation
---
.../MultiProjectAnalysisTests.fs | 20 +++++++------------
1 file changed, 7 insertions(+), 13 deletions(-)
diff --git a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
index 8d8471cbae3..b6f5231fcb6 100644
--- a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
@@ -1,7 +1,4 @@
-// Because of shared physical files
-// TODO: make the test cases independent
-[]
-module FSharp.Compiler.Service.Tests.MultiProjectAnalysisTests
+module FSharp.Compiler.Service.Tests.MultiProjectAnalysisTests
open Xunit
open FsUnit
@@ -446,8 +443,12 @@ let z = Project1.x
OtherOptions = Array.append options.OtherOptions [| ("-r:" + MultiProjectDirty1.dllName) |]
ReferencedProjects = [| FSharpReferencedProject.FSharpReference(MultiProjectDirty1.dllName, MultiProjectDirty1.getOptions()) |] }
+// Because of writing to shared physical files
+// TODO: make the test cases independent
+[]
[]
-[]
+// Investigate: check count varies betweeen 5 and 6
+// []
[]
let ``Test multi project symbols should pick up changes in dependent projects`` useTransparentCompiler =
@@ -457,10 +458,6 @@ let ``Test multi project symbols should pick up changes in dependent projects``
// register to count the file checks
let mutable count = 0
- let waitForCount n =
- if count > n then failwith $"checks count {count}, expected {n}"
- System.Threading.SpinWait.SpinUntil(fun () -> count = n)
-
checker.FileChecked.Add (fun _ -> System.Threading.Interlocked.Increment &count |> ignore)
//---------------- Write the first version of the file in project 1 and check the project --------------------
@@ -518,7 +515,6 @@ let ``Test multi project symbols should pick up changes in dependent projects``
let wt1 = FileSystem.GetLastWriteTimeShim MultiProjectDirty1.fileName1
printfn "Writing new content to file '%s'" MultiProjectDirty1.fileName1
- System.Threading.Thread.Sleep(1000)
FileSystem.OpenFileForWriteShim(MultiProjectDirty1.fileName1).Write(System.Environment.NewLine + MultiProjectDirty1.content)
printfn "Wrote new content to file '%s'" MultiProjectDirty1.fileName1
let wt2 = FileSystem.GetLastWriteTimeShim MultiProjectDirty1.fileName1
@@ -566,7 +562,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
let wt0b = System.DateTime.UtcNow
let wt1b = FileSystem.GetLastWriteTimeShim MultiProjectDirty1.fileName1
printfn "Writing old content to file '%s'" MultiProjectDirty1.fileName1
- System.Threading.Thread.Sleep(1000)
+ //System.Threading.Thread.Sleep(1000)
FileSystem.OpenFileForWriteShim(MultiProjectDirty1.fileName1).Write(MultiProjectDirty1.content)
printfn "Wrote old content to file '%s'" MultiProjectDirty1.fileName1
let wt2b = FileSystem.GetLastWriteTimeShim MultiProjectDirty1.fileName1
@@ -577,8 +573,6 @@ let ``Test multi project symbols should pick up changes in dependent projects``
count |> shouldEqual 4
let wholeProjectResults2AfterChange2 = checker.ParseAndCheckProject(proj2options) |> Async.RunImmediate
- System.Threading.Thread.Sleep(1000)
- waitForCount 6
count |> shouldEqual 6 // note, causes two files to be type checked, one from each project
From 7b709b59642b41b4f2ede271c76bcd7f7e0cb905 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Tue, 29 Oct 2024 12:42:45 +0100
Subject: [PATCH 17/21] run ProjectAnalysisTests in sequence
---
.../ProjectAnalysisTests.fs | 13 +++----------
1 file changed, 3 insertions(+), 10 deletions(-)
diff --git a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs
index 8bfc0a67e9a..561795cf9c8 100644
--- a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs
@@ -1,4 +1,5 @@
-module FSharp.Compiler.Service.Tests.ProjectAnalysisTests
+[]
+module FSharp.Compiler.Service.Tests.ProjectAnalysisTests
#nowarn "57" // Experimental stuff
open FSharp.Compiler.CodeAnalysis
@@ -127,15 +128,7 @@ let ``Test project1 and make sure TcImports gets cleaned up`` () =
let weakTcImports = test ()
checker.InvalidateConfiguration Project1.options
checker.ClearLanguageServiceRootCachesAndCollectAndFinalizeAllTransients()
-
- //collect 2 more times for good measure,
- // See for example: https://github.com/dotnet/runtime/discussions/108081
- GC.Collect(2, GCCollectionMode.Forced, true)
- GC.WaitForPendingFinalizers()
- GC.Collect()
- GC.WaitForPendingFinalizers()
-
- Assert.False weakTcImports.IsAlive
+ System.Threading.SpinWait.SpinUntil(fun () -> not weakTcImports.IsAlive)
[]
let ``Test Project1 should have protected FullName and TryFullName return same results`` () =
From 3168420636031f3b9ec713e60082d66513fdfa84 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Tue, 29 Oct 2024 12:43:09 +0100
Subject: [PATCH 18/21] wip
---
.../MultiProjectAnalysisTests.fs | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
index b6f5231fcb6..14e603cbf76 100644
--- a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
@@ -141,6 +141,7 @@ let ``Test multi project 1 basic`` useTransparentCompiler =
[ for x in wholeProjectResults.AssemblySignature.Entities[0].MembersFunctionsAndValues -> x.DisplayName ]
|> shouldEqual ["p"; "c"; "u"]
+[]
[]
[]
[]
@@ -361,6 +362,7 @@ let ``Test ManyProjectsStressTest cache too small`` useTransparentCompiler =
[ for x in wholeProjectResults.AssemblySignature.Entities[0].MembersFunctionsAndValues -> x.DisplayName ]
|> shouldEqual ["p"]
+[]
[]
[]
[]
@@ -518,6 +520,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
FileSystem.OpenFileForWriteShim(MultiProjectDirty1.fileName1).Write(System.Environment.NewLine + MultiProjectDirty1.content)
printfn "Wrote new content to file '%s'" MultiProjectDirty1.fileName1
let wt2 = FileSystem.GetLastWriteTimeShim MultiProjectDirty1.fileName1
+ Assert.NotEqual(wt1, wt2)
printfn "Current time: '%A', ticks = %d" wt0 wt0.Ticks
printfn "Old write time: '%A', ticks = %d" wt1 wt1.Ticks
printfn "New write time: '%A', ticks = %d" wt2 wt2.Ticks
@@ -566,6 +569,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
FileSystem.OpenFileForWriteShim(MultiProjectDirty1.fileName1).Write(MultiProjectDirty1.content)
printfn "Wrote old content to file '%s'" MultiProjectDirty1.fileName1
let wt2b = FileSystem.GetLastWriteTimeShim MultiProjectDirty1.fileName1
+ Assert.NotEqual(wt1b, wt2b)
printfn "Current time: '%A', ticks = %d" wt0b wt0b.Ticks
printfn "Old write time: '%A', ticks = %d" wt1b wt1b.Ticks
printfn "New write time: '%A', ticks = %d" wt2b wt2b.Ticks
From e159de9473143ed92e60ceff282a1468b254b9d5 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Tue, 29 Oct 2024 14:08:08 +0100
Subject: [PATCH 19/21] run ModuleReaderCancellationTests in sequence
---
.../ModuleReaderCancellationTests.fs | 1 +
1 file changed, 1 insertion(+)
diff --git a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs
index ed245117916..98f301c3450 100644
--- a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs
@@ -1,3 +1,4 @@
+[]
module FSharp.Compiler.Service.Tests.ModuleReaderCancellationTests
open System
From fc164e9d01e7a105230dafaf7bf8f183f7e9b66e Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Tue, 29 Oct 2024 14:08:38 +0100
Subject: [PATCH 20/21] make some MultiProjectAnalysisTests independent
---
.../MultiProjectAnalysisTests.fs | 115 ++++++++++--------
1 file changed, 65 insertions(+), 50 deletions(-)
diff --git a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
index 14e603cbf76..cb0b2248e76 100644
--- a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs
@@ -264,12 +264,12 @@ let ``Test multi project 1 xmldoc`` useTransparentCompiler =
//------------------------------------------------------------------------------------
+type private Project = { ModuleName: string; FileName: string; Options: FSharpProjectOptions; DllName: string }
// A project referencing many sub-projects
-module internal ManyProjectsStressTest =
+type private ManyProjectsStressTest() =
let numProjectsForStressTest = 100
- type Project = { ModuleName: string; FileName: string; Options: FSharpProjectOptions; DllName: string }
let projects =
[ for i in 1 .. numProjectsForStressTest do
let fileName1 = Path.ChangeExtension(getTemporaryFileName (), ".fs")
@@ -326,18 +326,25 @@ let p = ("""
|> function Some x -> x | None -> if a = jointProject.FileName then "fileN" else "??"
- let makeCheckerForStressTest ensureBigEnough useTransparentCompiler =
+ member _.JointProject = jointProject
+ member _.Projects = projects
+ member _.CleanFileName a = cleanFileName a
+ static member MakeCheckerForStressTest ensureBigEnough useTransparentCompiler =
let size = (if ensureBigEnough then numProjectsForStressTest + 10 else numProjectsForStressTest / 2 )
FSharpChecker.Create(projectCacheSize=size, useTransparentCompiler=useTransparentCompiler)
+
+
[]
[]
[]
let ``Test ManyProjectsStressTest basic`` useTransparentCompiler =
- let checker = ManyProjectsStressTest.makeCheckerForStressTest true useTransparentCompiler
+ let manyProjectsStressTest = ManyProjectsStressTest()
- let wholeProjectResults = checker.ParseAndCheckProject(ManyProjectsStressTest.jointProject.Options) |> Async.RunImmediate
+ let checker = ManyProjectsStressTest.MakeCheckerForStressTest true useTransparentCompiler
+
+ let wholeProjectResults = checker.ParseAndCheckProject(manyProjectsStressTest.JointProject.Options) |> Async.RunImmediate
[ for x in wholeProjectResults.AssemblySignature.Entities -> x.DisplayName ] |> shouldEqual ["JointProject"]
@@ -351,9 +358,11 @@ let ``Test ManyProjectsStressTest basic`` useTransparentCompiler =
[]
let ``Test ManyProjectsStressTest cache too small`` useTransparentCompiler =
- let checker = ManyProjectsStressTest.makeCheckerForStressTest false useTransparentCompiler
+ let manyProjectsStressTest = ManyProjectsStressTest()
+
+ let checker = ManyProjectsStressTest.MakeCheckerForStressTest false useTransparentCompiler
- let wholeProjectResults = checker.ParseAndCheckProject(ManyProjectsStressTest.jointProject.Options) |> Async.RunImmediate
+ let wholeProjectResults = checker.ParseAndCheckProject(manyProjectsStressTest.JointProject.Options) |> Async.RunImmediate
[ for x in wholeProjectResults.AssemblySignature.Entities -> x.DisplayName ] |> shouldEqual ["JointProject"]
@@ -362,17 +371,19 @@ let ``Test ManyProjectsStressTest cache too small`` useTransparentCompiler =
[ for x in wholeProjectResults.AssemblySignature.Entities[0].MembersFunctionsAndValues -> x.DisplayName ]
|> shouldEqual ["p"]
-[]
[]
[]
[]
let ``Test ManyProjectsStressTest all symbols`` useTransparentCompiler =
- let checker = ManyProjectsStressTest.makeCheckerForStressTest true useTransparentCompiler
+ let manyProjectsStressTest = ManyProjectsStressTest()
+
+
+ let checker = ManyProjectsStressTest.MakeCheckerForStressTest true useTransparentCompiler
for i in 1 .. 10 do
printfn "stress test iteration %d (first may be slow, rest fast)" i
- let projectsResults = [ for p in ManyProjectsStressTest.projects -> p, checker.ParseAndCheckProject(p.Options) |> Async.RunImmediate ]
- let jointProjectResults = checker.ParseAndCheckProject(ManyProjectsStressTest.jointProject.Options) |> Async.RunImmediate
+ let projectsResults = [ for p in manyProjectsStressTest.Projects -> p, checker.ParseAndCheckProject(p.Options) |> Async.RunImmediate ]
+ let jointProjectResults = checker.ParseAndCheckProject(manyProjectsStressTest.JointProject.Options) |> Async.RunImmediate
let vsFromJointProject =
[ for s in jointProjectResults.GetAllUsesOfAllSymbols() do
@@ -390,13 +401,13 @@ let ``Test ManyProjectsStressTest all symbols`` useTransparentCompiler =
let usesFromJointProject =
jointProjectResults.GetUsesOfSymbol(vFromProject)
- |> Array.map (fun s -> s.Symbol.DisplayName, ManyProjectsStressTest.cleanFileName s.FileName, tups s.Symbol.DeclarationLocation.Value)
+ |> Array.map (fun s -> s.Symbol.DisplayName, manyProjectsStressTest.CleanFileName s.FileName, tups s.Symbol.DeclarationLocation.Value)
usesFromJointProject.Length |> shouldEqual 1
//-----------------------------------------------------------------------------------------
-module internal MultiProjectDirty1 =
+type internal MultiProjectDirty1() =
let fileName1 = Path.ChangeExtension(getTemporaryFileName (), ".fs")
let baseName = getTemporaryFileName()
@@ -407,18 +418,20 @@ module internal MultiProjectDirty1 =
let x = "F#"
"""
- FileSystem.OpenFileForWriteShim(fileName1).Write(content)
+ do FileSystem.OpenFileForWriteShim(fileName1).Write(content)
- let cleanFileName a = if a = fileName1 then "Project1" else "??"
let fileNames = [|fileName1|]
- let getOptions() =
+ member _.Content = content
+ member _.CleanFileName a = if a = fileName1 then "Project1" else "??"
+ member _.DllName = dllName
+ member _.FileName1 = fileName1
+ member _.GetOptions() =
let args = mkProjectCommandLineArgs (dllName, fileNames)
{ checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) with SourceFiles = fileNames }
-module internal MultiProjectDirty2 =
-
+type internal MultiProjectDirty2(multiProjectDirty1: MultiProjectDirty1) =
let fileName1 = Path.ChangeExtension(getTemporaryFileName (), ".fs")
let baseName = getTemporaryFileName ()
@@ -432,31 +445,33 @@ open Project1
let y = x
let z = Project1.x
"""
- FileSystem.OpenFileForWriteShim(fileName1).Write(content)
+ do FileSystem.OpenFileForWriteShim(fileName1).Write(content)
let cleanFileName a = if a = fileName1 then "Project2" else "??"
let fileNames = [|fileName1|]
- let getOptions() =
+ member _.CleanFileName a = cleanFileName a
+ member _.DllName = dllName
+ member _.FileName1 = fileName1
+ member _.GetOptions() =
let args = mkProjectCommandLineArgs (dllName, fileNames)
let options = { checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) with SourceFiles = fileNames }
{ options with
- OtherOptions = Array.append options.OtherOptions [| ("-r:" + MultiProjectDirty1.dllName) |]
- ReferencedProjects = [| FSharpReferencedProject.FSharpReference(MultiProjectDirty1.dllName, MultiProjectDirty1.getOptions()) |] }
+ OtherOptions = Array.append options.OtherOptions [| ("-r:" + multiProjectDirty1.DllName) |]
+ ReferencedProjects = [| FSharpReferencedProject.FSharpReference(multiProjectDirty1.DllName, multiProjectDirty1.GetOptions()) |] }
-// Because of writing to shared physical files
-// TODO: make the test cases independent
-[]
[]
-// Investigate: check count varies betweeen 5 and 6
-// []
+[]
[]
let ``Test multi project symbols should pick up changes in dependent projects`` useTransparentCompiler =
// A private checker because we subscribe to FileChecked.
let checker = FSharpChecker.Create(useTransparentCompiler = useTransparentCompiler)
+ let multiProjectDirty1 = MultiProjectDirty1()
+ let multiProjectDirty2 = MultiProjectDirty2(multiProjectDirty1)
+
// register to count the file checks
let mutable count = 0
@@ -464,14 +479,14 @@ let ``Test multi project symbols should pick up changes in dependent projects``
//---------------- Write the first version of the file in project 1 and check the project --------------------
- let proj1options = MultiProjectDirty1.getOptions()
+ let proj1options = multiProjectDirty1.GetOptions()
let wholeProjectResults1 = checker.ParseAndCheckProject(proj1options) |> Async.RunImmediate
count |> shouldEqual 1
let backgroundParseResults1, backgroundTypedParse1 =
- checker.GetBackgroundCheckResultsForFileInProject(MultiProjectDirty1.fileName1, proj1options)
+ checker.GetBackgroundCheckResultsForFileInProject(multiProjectDirty1.FileName1, proj1options)
|> Async.RunImmediate
count |> shouldEqual 1
@@ -484,7 +499,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
printfn "Symbol found. Checking symbol uses in another project..."
- let proj2options = MultiProjectDirty2.getOptions()
+ let proj2options = multiProjectDirty2.GetOptions()
let wholeProjectResults2 = checker.ParseAndCheckProject(proj2options) |> Async.RunImmediate
@@ -496,7 +511,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
let usesOfXSymbolInProject1 =
wholeProjectResults1.GetUsesOfSymbol(xSymbol)
- |> Array.map (fun su -> su.Symbol.ToString(), MultiProjectDirty1.cleanFileName su.FileName, tups su.Range)
+ |> Array.map (fun su -> su.Symbol.ToString(), multiProjectDirty1.CleanFileName su.FileName, tups su.Range)
usesOfXSymbolInProject1
|> shouldEqual
@@ -504,7 +519,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
let usesOfXSymbolInProject2 =
wholeProjectResults2.GetUsesOfSymbol(xSymbol)
- |> Array.map (fun su -> su.Symbol.ToString(), MultiProjectDirty2.cleanFileName su.FileName, tups su.Range)
+ |> Array.map (fun su -> su.Symbol.ToString(), multiProjectDirty2.CleanFileName su.FileName, tups su.Range)
usesOfXSymbolInProject2
|> shouldEqual
@@ -514,12 +529,11 @@ let ``Test multi project symbols should pick up changes in dependent projects``
//---------------- Change the file by adding a line, then re-check everything --------------------
let wt0 = System.DateTime.UtcNow
- let wt1 = FileSystem.GetLastWriteTimeShim MultiProjectDirty1.fileName1
- printfn "Writing new content to file '%s'" MultiProjectDirty1.fileName1
-
- FileSystem.OpenFileForWriteShim(MultiProjectDirty1.fileName1).Write(System.Environment.NewLine + MultiProjectDirty1.content)
- printfn "Wrote new content to file '%s'" MultiProjectDirty1.fileName1
- let wt2 = FileSystem.GetLastWriteTimeShim MultiProjectDirty1.fileName1
+ let wt1 = FileSystem.GetLastWriteTimeShim multiProjectDirty1.FileName1
+ printfn "Writing new content to file '%s'" multiProjectDirty1.FileName1
+ FileSystem.OpenFileForWriteShim(multiProjectDirty1.FileName1).Write(System.Environment.NewLine + multiProjectDirty1.Content)
+ printfn "Wrote new content to file '%s'" multiProjectDirty1.FileName1
+ let wt2 = FileSystem.GetLastWriteTimeShim multiProjectDirty1.FileName1
Assert.NotEqual(wt1, wt2)
printfn "Current time: '%A', ticks = %d" wt0 wt0.Ticks
printfn "Old write time: '%A', ticks = %d" wt1 wt1.Ticks
@@ -529,7 +543,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
count |> shouldEqual 3
let backgroundParseResults1AfterChange1, backgroundTypedParse1AfterChange1 =
- checker.GetBackgroundCheckResultsForFileInProject(MultiProjectDirty1.fileName1, proj1options)
+ checker.GetBackgroundCheckResultsForFileInProject(multiProjectDirty1.FileName1, proj1options)
|> Async.RunImmediate
let xSymbolUseAfterChange1 = backgroundTypedParse1AfterChange1.GetSymbolUseAtLocation(4, 4, "", ["x"])
@@ -545,7 +559,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
let usesOfXSymbolInProject1AfterChange1 =
wholeProjectResults1AfterChange1.GetUsesOfSymbol(xSymbolAfterChange1)
- |> Array.map (fun su -> su.Symbol.ToString(), MultiProjectDirty1.cleanFileName su.FileName, tups su.Range)
+ |> Array.map (fun su -> su.Symbol.ToString(), multiProjectDirty1.CleanFileName su.FileName, tups su.Range)
usesOfXSymbolInProject1AfterChange1
|> shouldEqual
@@ -553,7 +567,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
let usesOfXSymbolInProject2AfterChange1 =
wholeProjectResults2AfterChange1.GetUsesOfSymbol(xSymbolAfterChange1)
- |> Array.map (fun su -> su.Symbol.ToString(), MultiProjectDirty2.cleanFileName su.FileName, tups su.Range)
+ |> Array.map (fun su -> su.Symbol.ToString(), multiProjectDirty2.CleanFileName su.FileName, tups su.Range)
usesOfXSymbolInProject2AfterChange1
|> shouldEqual
@@ -563,17 +577,18 @@ let ``Test multi project symbols should pick up changes in dependent projects``
//---------------- Revert the change to the file --------------------
let wt0b = System.DateTime.UtcNow
- let wt1b = FileSystem.GetLastWriteTimeShim MultiProjectDirty1.fileName1
- printfn "Writing old content to file '%s'" MultiProjectDirty1.fileName1
- //System.Threading.Thread.Sleep(1000)
- FileSystem.OpenFileForWriteShim(MultiProjectDirty1.fileName1).Write(MultiProjectDirty1.content)
- printfn "Wrote old content to file '%s'" MultiProjectDirty1.fileName1
- let wt2b = FileSystem.GetLastWriteTimeShim MultiProjectDirty1.fileName1
+ let wt1b = FileSystem.GetLastWriteTimeShim multiProjectDirty1.FileName1
+ printfn "Writing old content to file '%s'" multiProjectDirty1.FileName1
+ FileSystem.OpenFileForWriteShim(multiProjectDirty1.FileName1).Write(multiProjectDirty1.Content)
+ printfn "Wrote old content to file '%s'" multiProjectDirty1.FileName1
+ let wt2b = FileSystem.GetLastWriteTimeShim multiProjectDirty1.FileName1
Assert.NotEqual(wt1b, wt2b)
printfn "Current time: '%A', ticks = %d" wt0b wt0b.Ticks
printfn "Old write time: '%A', ticks = %d" wt1b wt1b.Ticks
printfn "New write time: '%A', ticks = %d" wt2b wt2b.Ticks
+ System.Threading.Thread.Sleep(1000)
+
count |> shouldEqual 4
let wholeProjectResults2AfterChange2 = checker.ParseAndCheckProject(proj2options) |> Async.RunImmediate
@@ -585,7 +600,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
count |> shouldEqual 6 // the project is already checked
let backgroundParseResults1AfterChange2, backgroundTypedParse1AfterChange2 =
- checker.GetBackgroundCheckResultsForFileInProject(MultiProjectDirty1.fileName1, proj1options)
+ checker.GetBackgroundCheckResultsForFileInProject(multiProjectDirty1.FileName1, proj1options)
|> Async.RunImmediate
let xSymbolUseAfterChange2 = backgroundTypedParse1AfterChange2.GetSymbolUseAtLocation(4, 4, "", ["x"])
@@ -595,7 +610,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
let usesOfXSymbolInProject1AfterChange2 =
wholeProjectResults1AfterChange2.GetUsesOfSymbol(xSymbolAfterChange2)
- |> Array.map (fun su -> su.Symbol.ToString(), MultiProjectDirty1.cleanFileName su.FileName, tups su.Range)
+ |> Array.map (fun su -> su.Symbol.ToString(), multiProjectDirty1.CleanFileName su.FileName, tups su.Range)
usesOfXSymbolInProject1AfterChange2
|> shouldEqual
@@ -604,7 +619,7 @@ let ``Test multi project symbols should pick up changes in dependent projects``
let usesOfXSymbolInProject2AfterChange2 =
wholeProjectResults2AfterChange2.GetUsesOfSymbol(xSymbolAfterChange2)
- |> Array.map (fun su -> su.Symbol.ToString(), MultiProjectDirty2.cleanFileName su.FileName, tups su.Range)
+ |> Array.map (fun su -> su.Symbol.ToString(), multiProjectDirty2.CleanFileName su.FileName, tups su.Range)
usesOfXSymbolInProject2AfterChange2
|> shouldEqual
From dc0aeaae52b141e1608238136b96a2a2971caf65 Mon Sep 17 00:00:00 2001
From: Jakub Majocha <1760221+majocha@users.noreply.github.com>
Date: Tue, 29 Oct 2024 15:44:17 +0100
Subject: [PATCH 21/21] try fix test
---
src/Compiler/Facilities/AsyncMemoize.fs | 2 +-
.../FSharpChecker/TransparentCompiler.fs | 3 +--
2 files changed, 2 insertions(+), 3 deletions(-)
diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs
index d22093a2b4f..d1c713fed1a 100644
--- a/src/Compiler/Facilities/AsyncMemoize.fs
+++ b/src/Compiler/Facilities/AsyncMemoize.fs
@@ -564,7 +564,7 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T
member this.OnEvent = this.Event.Add
- member this.Count = cache.Count
+ member this.Count = lock.Do(fun () -> Task.FromResult cache.Count).Result
member _.Locked = lock.Semaphore.CurrentCount < 1
diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs
index 8c9e020c8fb..f5c80cf7f96 100644
--- a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs
+++ b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs
@@ -1012,13 +1012,12 @@ printfn "Hello from F#"
[]
let ``Transparent Compiler ScriptClosure cache is populated after GetProjectOptionsFromScript`` () =
- async {
+ task {
let transparentChecker = FSharpChecker.Create(useTransparentCompiler = true)
let scriptName = Path.Combine(__SOURCE_DIRECTORY__, "script.fsx")
let content = SourceTextNew.ofString ""
let! _ = transparentChecker.GetProjectOptionsFromScript(scriptName, content)
Assert.Equal(1, transparentChecker.Caches.ScriptClosure.Count)
-
}
type private LoadClosureTestShim(currentFileSystem: IFileSystem) =