diff --git a/eng/Build.ps1 b/eng/Build.ps1 index 483b60b10df..ab7383a7dde 100644 --- a/eng/Build.ps1 +++ b/eng/Build.ps1 @@ -362,36 +362,39 @@ function VerifyAssemblyVersionsAndSymbols() { } } -function TestUsingMSBuild([string] $testProject, [string] $targetFramework, [string]$testadapterpath, [boolean] $asBackgroundJob = $false) { +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.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" + $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) { - $args += " --no-restore" + $arguments += " --no-restore" } if (-not $noVisualStudio) { - $args += " --no-build" + $arguments += " --no-build" } + $arguments += " $settings" + if ($asBackgroundJob) { - Write-Host("Starting on the background: $args") + 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 } } @@ -588,32 +591,29 @@ try { $script:BuildCategory = "Test" $script:BuildMessage = "Failure running tests" - if ($testCoreClr) { - $bgJob = TestUsingMSBuild -testProject "$RepoRoot\tests\fsharp\FSharpSuite.Tests.fsproj" -targetFramework $script:coreclrTargetFramework -testadapterpath "$ArtifactsDir\bin\FSharpSuite.Tests\" -asBackgroundJob $true - - 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\" + function Receive($job) { + while($job.HasMoreData) { + Receive-Job $job | Write-Host + Start-Sleep -Seconds 1 + } + Receive-Job $job -Wait -ErrorAction Stop + } - # Collect output from background jobs - Wait-job $bgJob | out-null - Receive-Job $bgJob -ErrorAction Stop + if ($testCoreClr) { + $cpuLimit = if ($ci) { "-m:2 -- xUnit.MaxParallelThreads=0.25x" } else { "" } + 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\" -asBackgroundJob $true + $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\" - # Collect output from background jobs - Wait-job $bgJob | out-null - Receive-Job $bgJob -ErrorAction Stop + Receive -job $bgJob } if ($testFSharpQA) { @@ -644,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/eng/Versions.props b/eng/Versions.props index 658ed0f5d9e..f755fe6eac0 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 33dd1c42c46..fa52c896178 100644 --- a/src/Compiler/Driver/GraphChecking/GraphProcessing.fs +++ b/src/Compiler/Driver/GraphChecking/GraphProcessing.fs @@ -2,8 +2,6 @@ open System.Threading open FSharp.Compiler.GraphChecking -open System.Threading.Tasks -open System /// Information about the node in a graph, describing its relation with other nodes. type NodeInfo<'Item> = @@ -176,15 +174,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 +217,8 @@ 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 = + let rec processNode (node: GraphNode<'Item, 'Result>) = async { - let info = node.Info let! singleRes = work getItemPublicNode info @@ -280,14 +234,10 @@ 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 processNode |> 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 processNode |> Async.Parallel |> Async.Ignore // All calculations succeeded - extract the results and sort in input order. return diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index d22093a2b4f..af1a52e5e5d 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -172,6 +172,8 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T let mutable strengthened = 0 let mutable cleared = 0 + let mutable updates_in_flight = 0 + let mutable cancel_ct_registration_original = 0 let mutable cancel_exception_original = 0 let mutable cancel_original_processed = 0 @@ -325,154 +327,154 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T // raise ex -- Suppose there's no need to raise here - where does it even go? let processStateUpdate post (key: KeyData<_, _>, action: StateUpdate<_>) = - task { - do! Task.Yield() - - do! - lock.Do(fun () -> - task { - - let cached = cache.TryGet(key.Key, key.Version) - - match action, cached with - - | OriginatorCanceled, Some(Running(tcs, cts, computation, _, _)) -> - - Interlocked.Increment &cancel_original_processed |> ignore - - decrRequestCount key - - if requestCounts[key] < 1 then - cancelRegistration key - cts.Cancel() - tcs.TrySetCanceled() |> ignore - // Remember the job in case it completes after cancellation - cache.Set(key.Key, key.Version, key.Label, Job.Canceled DateTime.Now) - requestCounts.Remove key |> ignore - log (Canceled, key) - Interlocked.Increment &canceled |> ignore - use _ = Activity.start $"{name}: Canceled job" [| "key", key.Label |] - () - - else - // We need to restart the computation - Task.Run(fun () -> - Async.StartAsTask( - async { - - let cachingLogger = new CachingDiagnosticsLogger(None) - - try - // TODO: Should unify starting and restarting - log (Restarted, key) - Interlocked.Increment &restarted |> ignore - System.Diagnostics.Trace.TraceInformation $"{name} Restarted {key.Label}" - let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger - DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger - - try - let! result = computation - post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics))) - return () - finally - DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger - with - | TaskCancelled _ -> - Interlocked.Increment &cancel_exception_subsequent |> ignore - post (key, CancelRequest) - () - | ex -> post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) - } - ), - cts.Token) - |> ignore - - | CancelRequest, Some(Running(tcs, cts, _c, _, _)) -> - - Interlocked.Increment &cancel_subsequent_processed |> ignore - - decrRequestCount key - - if requestCounts[key] < 1 then - cancelRegistration key - cts.Cancel() - tcs.TrySetCanceled() |> ignore - // Remember the job in case it completes after cancellation - cache.Set(key.Key, key.Version, key.Label, Job.Canceled DateTime.Now) - requestCounts.Remove key |> ignore - log (Canceled, key) - Interlocked.Increment &canceled |> ignore - use _ = Activity.start $"{name}: Canceled job" [| "key", key.Label |] - () - - // Probably in some cases cancellation can be fired off even after we just unregistered it - | CancelRequest, None - | CancelRequest, Some(Completed _) - | CancelRequest, Some(Job.Canceled _) - | CancelRequest, Some(Job.Failed _) - | OriginatorCanceled, None - | OriginatorCanceled, Some(Completed _) - | OriginatorCanceled, Some(Job.Canceled _) - | OriginatorCanceled, Some(Job.Failed _) -> () - - | JobFailed(ex, diags), Some(Running(tcs, _cts, _c, _ts, loggers)) -> - cancelRegistration key - cache.Set(key.Key, key.Version, key.Label, Job.Failed(DateTime.Now, ex)) - requestCounts.Remove key |> ignore - log (Failed, key) - Interlocked.Increment &failed |> ignore - failures.Add(key.Label, ex) - - for logger in loggers do - diags |> replayDiagnostics logger - - tcs.TrySetException ex |> ignore - - | JobCompleted(result, diags), Some(Running(tcs, _cts, _c, started, loggers)) -> - cancelRegistration key - cache.Set(key.Key, key.Version, key.Label, (Completed(result, diags))) - requestCounts.Remove key |> ignore - log (Finished, key) - Interlocked.Increment &completed |> ignore - let duration = float (DateTime.Now - started).Milliseconds - - avgDurationMs <- - if completed < 2 then - duration - else - avgDurationMs + (duration - avgDurationMs) / float completed - - for logger in loggers do - diags |> replayDiagnostics logger - - if tcs.TrySetResult result = false then - internalError key.Label "Invalid state: Completed job already completed" - - // Sometimes job can be canceled but it still manages to complete (or fail) - | JobFailed _, Some(Job.Canceled _) - | JobCompleted _, Some(Job.Canceled _) -> () - - // Job can't be evicted from cache while it's running because then subsequent requesters would be waiting forever - | JobFailed _, None -> internalError key.Label "Invalid state: Running job missing in cache (failed)" - - | JobCompleted _, None -> internalError key.Label "Invalid state: Running job missing in cache (completed)" - - | JobFailed(ex, _diags), Some(Completed(_job, _diags2)) -> - internalError key.Label $"Invalid state: Failed Completed job \n%A{ex}" - - | JobCompleted(_result, _diags), Some(Completed(_job, _diags2)) -> - internalError key.Label "Invalid state: Double-Completed job" - - | JobFailed(ex, _diags), Some(Job.Failed(_, ex2)) -> - internalError key.Label $"Invalid state: Double-Failed job \n%A{ex} \n%A{ex2}" - - | JobCompleted(_result, _diags), Some(Job.Failed(_, ex2)) -> - internalError key.Label $"Invalid state: Completed Failed job \n%A{ex2}" - }) - } + lock.Do(fun () -> + task { + + let cached = cache.TryGet(key.Key, key.Version) + + match action, cached with + + | OriginatorCanceled, Some(Running(tcs, cts, computation, _, _)) -> + + Interlocked.Increment &cancel_original_processed |> ignore + + decrRequestCount key + + if requestCounts[key] < 1 then + cancelRegistration key + cts.Cancel() + tcs.TrySetCanceled() |> ignore + // Remember the job in case it completes after cancellation + cache.Set(key.Key, key.Version, key.Label, Job.Canceled DateTime.Now) + requestCounts.Remove key |> ignore + log (Canceled, key) + Interlocked.Increment &canceled |> ignore + use _ = Activity.start $"{name}: Canceled job" [| "key", key.Label |] + () + + else + // We need to restart the computation + Task.Run(fun () -> + Async.StartAsTask( + async { + + let cachingLogger = new CachingDiagnosticsLogger(None) + + try + // TODO: Should unify starting and restarting + log (Restarted, key) + Interlocked.Increment &restarted |> ignore + System.Diagnostics.Trace.TraceInformation $"{name} Restarted {key.Label}" + let currentLogger = DiagnosticsThreadStatics.DiagnosticsLogger + DiagnosticsThreadStatics.DiagnosticsLogger <- cachingLogger + + try + let! result = computation + post (key, (JobCompleted(result, cachingLogger.CapturedDiagnostics))) + return () + finally + DiagnosticsThreadStatics.DiagnosticsLogger <- currentLogger + with + | TaskCancelled _ -> + Interlocked.Increment &cancel_exception_subsequent |> ignore + post (key, CancelRequest) + () + | ex -> post (key, (JobFailed(ex, cachingLogger.CapturedDiagnostics))) + } + ), + cts.Token) + |> ignore + + | CancelRequest, Some(Running(tcs, cts, _c, _, _)) -> + + Interlocked.Increment &cancel_subsequent_processed |> ignore + + decrRequestCount key + + if requestCounts[key] < 1 then + cancelRegistration key + cts.Cancel() + tcs.TrySetCanceled() |> ignore + // Remember the job in case it completes after cancellation + cache.Set(key.Key, key.Version, key.Label, Job.Canceled DateTime.Now) + requestCounts.Remove key |> ignore + log (Canceled, key) + Interlocked.Increment &canceled |> ignore + use _ = Activity.start $"{name}: Canceled job" [| "key", key.Label |] + () + + // Probably in some cases cancellation can be fired off even after we just unregistered it + | CancelRequest, None + | CancelRequest, Some(Completed _) + | CancelRequest, Some(Job.Canceled _) + | CancelRequest, Some(Job.Failed _) + | OriginatorCanceled, None + | OriginatorCanceled, Some(Completed _) + | OriginatorCanceled, Some(Job.Canceled _) + | OriginatorCanceled, Some(Job.Failed _) -> () + + | JobFailed(ex, diags), Some(Running(tcs, _cts, _c, _ts, loggers)) -> + cancelRegistration key + cache.Set(key.Key, key.Version, key.Label, Job.Failed(DateTime.Now, ex)) + requestCounts.Remove key |> ignore + log (Failed, key) + Interlocked.Increment &failed |> ignore + failures.Add(key.Label, ex) + + for logger in loggers do + diags |> replayDiagnostics logger + + tcs.TrySetException ex |> ignore + + | JobCompleted(result, diags), Some(Running(tcs, _cts, _c, started, loggers)) -> + cancelRegistration key + cache.Set(key.Key, key.Version, key.Label, (Completed(result, diags))) + requestCounts.Remove key |> ignore + log (Finished, key) + Interlocked.Increment &completed |> ignore + let duration = float (DateTime.Now - started).Milliseconds + + avgDurationMs <- + if completed < 2 then + duration + else + avgDurationMs + (duration - avgDurationMs) / float completed + + for logger in loggers do + diags |> replayDiagnostics logger + + if tcs.TrySetResult result = false then + internalError key.Label "Invalid state: Completed job already completed" + + // Sometimes job can be canceled but it still manages to complete (or fail) + | JobFailed _, Some(Job.Canceled _) + | JobCompleted _, Some(Job.Canceled _) -> () + + // Job can't be evicted from cache while it's running because then subsequent requesters would be waiting forever + | JobFailed _, None -> internalError key.Label "Invalid state: Running job missing in cache (failed)" + + | JobCompleted _, None -> internalError key.Label "Invalid state: Running job missing in cache (completed)" + + | JobFailed(ex, _diags), Some(Completed(_job, _diags2)) -> + internalError key.Label $"Invalid state: Failed Completed job \n%A{ex}" + + | JobCompleted(_result, _diags), Some(Completed(_job, _diags2)) -> + internalError key.Label "Invalid state: Double-Completed job" + + | JobFailed(ex, _diags), Some(Job.Failed(_, ex2)) -> + internalError key.Label $"Invalid state: Double-Failed job \n%A{ex} \n%A{ex2}" + + | JobCompleted(_result, _diags), Some(Job.Failed(_, ex2)) -> + internalError key.Label $"Invalid state: Completed Failed job \n%A{ex2}" + }) let rec post msg = - Task.Run(fun () -> processStateUpdate post msg :> Task) |> ignore + Interlocked.Increment &updates_in_flight |> ignore + backgroundTask { + do! processStateUpdate post msg + Interlocked.Decrement &updates_in_flight |> ignore + } + |> ignore member this.Get'(key, computation) = @@ -564,7 +566,9 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T member this.OnEvent = this.Event.Add - member this.Count = cache.Count + member _.Count = lock.Do(fun () -> Task.FromResult cache.Count).Result + + member _.Updating = updates_in_flight > 0 member _.Locked = lock.Semaphore.CurrentCount < 1 diff --git a/src/Compiler/Facilities/AsyncMemoize.fsi b/src/Compiler/Facilities/AsyncMemoize.fsi index 049a06914a8..d86352d9987 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fsi +++ b/src/Compiler/Facilities/AsyncMemoize.fsi @@ -83,6 +83,8 @@ type internal AsyncMemoize<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'T member Count: int + member Updating: bool + /// A drop-in replacement for AsyncMemoize that disables caching and just runs the computation every time. type internal AsyncMemoizeDisabled<'TKey, 'TVersion, 'TValue when 'TKey: equality and 'TVersion: equality> = 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/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 index 6c6216a8377..86dccbc9135 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/utf8output.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/utf8output.fs @@ -7,6 +7,7 @@ open FSharp.Test open FSharp.Test.Compiler open System +[] module utf8output = [] 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/CompilerService/AsyncMemoize.fs b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs index 7b65ba798fe..e031aa9cbb9 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs +++ b/tests/FSharp.Compiler.ComponentTests/CompilerService/AsyncMemoize.fs @@ -11,83 +11,72 @@ open FSharp.Compiler.Diagnostics open Xunit -[] -module internal JobEvents = +let tap f x = f x; x - let publishEvent (cache: AsyncMemoize<_, _, _>) = - let wrapper = Event<_>() - cache.OnEvent (fun e -> lock wrapper <| fun () -> wrapper.Trigger e) - wrapper.Publish |> Event.map (fun (jobEvent, (_,k,_)) -> jobEvent, k) +let internal record (cache: AsyncMemoize<_,_,_>) = - let collectEvents cache = - cache |> publishEvent |> Event.scan (fun es e -> e :: es) [] |> Event.map List.rev + let events = ResizeArray() - /// Exposes a live view of the list of JobEvents generated by AsyncMemoize. - let observe cache = - let updateAvailable = new AutoResetEvent(false) - let mutable recorded = [] + let waitForIdle() = SpinWait.SpinUntil(fun () -> not cache.Updating) - let update next = - Debug.WriteLine $"%A{next}" - recorded <- next - updateAvailable.Set() |> ignore + waitForIdle() + cache.Event + |> Event.map (fun (e, (_, k, _)) -> e, k) + |> Event.add events.Add - collectEvents cache |> Event.add update + let getEvents () = + waitForIdle() + events |> List.ofSeq |> tap (printfn "events: %A") - let waitForUpdate = updateAvailable |> Async.AwaitWaitHandle |> Async.Ignore + getEvents - async { - Debug.WriteLine $"current: %A{recorded}" - return recorded, waitForUpdate - } +let check getEvents assertFunction = + let actual = getEvents() + assertFunction actual - let countOf value count events = events |> Seq.filter (fst >> (=) value) |> Seq.length |> (=) count +let waitUntil getEvents condition = + while getEvents() |> condition |> not do () - let received value events = events |> Seq.exists (fst >> (=) value) +let recorded (expected: 't list) (actual: 't list) = + Assert.Equal<'t>(expected, actual) - let waitUntil observedCache condition = - let rec loop() = async { - let! current, waitForUpdate = observedCache - if current |> condition |> not then - do! waitForUpdate - return! loop() - } - loop() +let countOf value count events = + events |> Seq.filter (fst >> (=) value) |> Seq.length |> (=) count + +let received value events = + events |> List.tryLast |> Option.map (fst >> (=) value) |> Option.defaultValue false [] let ``Basics``() = - task { - let computation key = async { - do! Async.Sleep 1 - return key * 2 - } + let computation key = async { + do! Async.Sleep 1 + return key * 2 + } - let memoize = AsyncMemoize() - let events = observe memoize - - let result = - seq { - memoize.Get'(5, computation 5) - memoize.Get'(5, computation 5) - memoize.Get'(2, computation 2) - memoize.Get'(5, computation 5) - memoize.Get'(3, computation 3) - memoize.Get'(2, computation 2) - } - |> Async.Parallel - |> Async.RunSynchronously + let memoize = AsyncMemoize() + let events = record memoize - let expected = [| 10; 10; 4; 10; 6; 4|] + let result = + seq { + memoize.Get'(5, computation 5) + memoize.Get'(5, computation 5) + memoize.Get'(2, computation 2) + memoize.Get'(5, computation 5) + memoize.Get'(3, computation 3) + memoize.Get'(2, computation 2) + } + |> Async.Parallel + |> Async.RunSynchronously - Assert.Equal(expected, result) + let expected = [| 10; 10; 4; 10; 6; 4|] - do! waitUntil events (countOf Finished 3) - let! current, _ = events - let groups = current |> Seq.groupBy snd |> Seq.toList + Assert.Equal(expected, result) + + check events <| fun events -> + let groups = events |> Seq.groupBy snd |> Seq.toList Assert.Equal(3, groups.Length) for key, events in groups do Assert.Equal>(Set [ Requested, key; Started, key; Finished, key ], Set events) - } [] let ``We can cancel a job`` () = @@ -106,7 +95,7 @@ let ``We can cancel a job`` () = } let memoize = AsyncMemoize<_, int, _>() - let events = observe memoize + let events = record memoize let key = 1 @@ -116,22 +105,14 @@ let ``We can cancel a job`` () = cts.Cancel() ctsCancelled.Set() - do! waitUntil events (received Canceled) - let! current, _ = events - - Assert.Equal<_ list>( - [ - Requested, key - Started, key - Canceled, key - ], - current - ) + check events recorded + [ Requested, key + Started, key + Canceled, key ] } [] let ``Job is restarted if first requestor cancels`` () = - task { let jobStarted = new SemaphoreSlim(0) let jobCanComplete = new ManualResetEventSlim(false) @@ -144,47 +125,39 @@ let ``Job is restarted if first requestor cancels`` () = } let memoize = AsyncMemoize<_, int, _>() - let events = observe memoize + let events = record memoize use cts1 = new CancellationTokenSource() - use cts2 = new CancellationTokenSource() - use cts3 = new CancellationTokenSource() let key = 1 let _task1 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts1.Token) - do! jobStarted.WaitAsync() - let _task2 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts2.Token) - let _task3 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts3.Token) + jobStarted.Wait() + let task2 = Async.StartAsTask( memoize.Get'(key, computation key)) + let task3 = Async.StartAsTask( memoize.Get'(key, computation key)) - do! waitUntil events (countOf Requested 3) + waitUntil events (countOf Requested 3) cts1.Cancel() jobCanComplete.Set() |> ignore - do! jobStarted.WaitAsync() - - let! result = _task2 - Assert.Equal(2, result) + jobStarted.Wait() - let! current, _ = events + Assert.Equal(2, task2.Result) + Assert.Equal(2, task3.Result) - Assert.Equal<_ list>( - [ Requested, key - Started, key - Requested, key - Requested, key - Restarted, key - Finished, key ], - current - ) - } + check events recorded + [ Requested, key + Started, key + Requested, key + Requested, key + Restarted, key + Finished, key ] [] let ``Job is restarted if first requestor cancels but keeps running if second requestor cancels`` () = - task { let jobStarted = new ManualResetEventSlim(false) let jobCanComplete = new ManualResetEventSlim(false) @@ -196,11 +169,10 @@ let ``Job is restarted if first requestor cancels but keeps running if second re } let memoize = AsyncMemoize<_, int, _>() - let events = observe memoize + let events = record memoize use cts1 = new CancellationTokenSource() use cts2 = new CancellationTokenSource() - use cts3 = new CancellationTokenSource() let key = 1 @@ -210,9 +182,9 @@ let ``Job is restarted if first requestor cancels but keeps running if second re jobStarted.Reset() |> ignore let _task2 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts2.Token) - let _task3 = Async.StartAsTask( memoize.Get'(key, computation key), cancellationToken = cts3.Token) + let task3 = Async.StartAsTask( memoize.Get'(key, computation key)) - do! waitUntil events (countOf Requested 3) + waitUntil events (countOf Requested 3) cts1.Cancel() @@ -222,27 +194,21 @@ let ``Job is restarted if first requestor cancels but keeps running if second re jobCanComplete.Set() |> ignore - let! result = _task3 - Assert.Equal(2, result) - - let! current, _ = events + Assert.Equal(2, task3.Result) - Assert.Equal<_ list>( + check events recorded [ Requested, key Started, key Requested, key Requested, key Restarted, key - Finished, key ], - current - ) - } + Finished, key ] type ExpectedException() = inherit Exception() -[] +[] let ``Stress test`` () = let seed = System.Random().Next() 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 82c6d363b47..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 + diff --git a/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs b/tests/FSharp.Compiler.ComponentTests/FSharpChecker/TransparentCompiler.fs index 0395a421895..def01c40147 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 @@ -26,10 +27,43 @@ open OpenTelemetry open OpenTelemetry.Resources open OpenTelemetry.Trace +module internal JobEvents = + let fileName fileId = $"File%s{fileId}.fs" + + let recordAll() = + let mutable cache : AsyncMemoize<_,_,_> option = None + let events = ResizeArray() + + let waitForIdle() = SpinWait.SpinUntil(fun () -> not cache.Value.Updating) + + let observe (getCache: CompilerCaches -> AsyncMemoize<_,_,_>) (checker: FSharpChecker) = + cache <- Some (getCache checker.Caches) + waitForIdle() + cache.Value.Event + |> Event.map (fun (e, (_l, (f: string, _p), _)) -> (Path.GetFileName f), e) + |> Event.add events.Add + + let getEvents () = + waitForIdle() + events |> List.ofSeq + + observe, getEvents + + let record() = + let observe, getEvents = recordAll() + + let check fileId expected = + let events = getEvents() + let fileName = fileName fileId + let actual = events |> Seq.filter (fun e -> fst e = fileName) |> Seq.map snd |> Seq.toList + printfn $"{fileId}: %A{actual}" + Assert.Equal(expected, actual) + + observe, check #nowarn "57" -[] +[] let ``Use Transparent Compiler`` () = let size = 20 @@ -59,7 +93,7 @@ let ``Use Transparent Compiler`` () = checkFile last expectSignatureChanged } -[] +[] let ``Parallel processing`` () = let project = SyntheticProject.Create( @@ -77,7 +111,7 @@ let ``Parallel processing`` () = checkFile "E" expectSignatureChanged } -[] +[] let ``Parallel processing with signatures`` () = let project = SyntheticProject.Create( @@ -112,7 +146,7 @@ let makeTestProject () = let testWorkflow () = ProjectWorkflowBuilder(makeTestProject(), useTransparentCompiler = true) -[] +[] let ``Edit file, check it, then check dependent file`` () = testWorkflow() { updateFile "First" breakDependentFiles @@ -120,21 +154,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) @@ -143,7 +177,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 @@ -153,7 +187,7 @@ let ``Files depend on signature file if present`` () = checkFile "Second" expectNoChanges } -[] +[] let ``Project with signatures`` () = let project = SyntheticProject.Create( @@ -168,7 +202,7 @@ let ``Project with signatures`` () = checkFile "Second" expectOk } -[] +[] let ``Signature update`` () = let project = SyntheticProject.Create( @@ -184,7 +218,7 @@ let ``Signature update`` () = checkFile "Second" expectSignatureChanged } -[] +[] let ``Adding a file`` () = testWorkflow() { addFileAbove "Second" (sourceFile "New" []) @@ -192,14 +226,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" []) @@ -218,55 +252,35 @@ let ``Changes in a referenced project`` () = } -[] +[] let ``File is not checked twice`` () = - let cacheEvents = ConcurrentQueue() + let observe, check = JobEvents.record() testWorkflow() { - withChecker (fun checker -> - async { - do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue - }) + withChecker (observe _.TcIntermediate) updateFile "First" updatePublicSurface checkFile "Third" expectOk } |> ignore - let intermediateTypeChecks = - cacheEvents - |> Seq.groupBy (fun (_e, (_l, (f, _p), _)) -> f |> Path.GetFileName) - |> Seq.map (fun (k, g) -> k, g |> Seq.map fst |> Seq.toList) - |> Map + check "First" [Weakened; Requested; Started; Finished] + check "Third" [Weakened; Requested; Started; Finished] - 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() + let observe, check = JobEvents.record() testWorkflow() { - withChecker (fun checker -> - async { - do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue - }) + withChecker (observe _.TcIntermediate) updateFile "First" updatePublicSurface checkFile "Last" expectOk checkFile "Third" expectOk } |> ignore - let intermediateTypeChecks = - cacheEvents - |> Seq.groupBy (fun (_e, (_l, (f, _p), _)) -> f |> Path.GetFileName) - |> Seq.map (fun (k, g) -> k, g |> Seq.map fst |> Seq.toList) - |> Map - - Assert.Equal([Weakened; Requested; Started; Finished; Requested], intermediateTypeChecks["FileThird.fs"]) + check "Third" [Weakened; Requested; Started; Finished; Requested] - -// [] 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" [], @@ -276,12 +290,8 @@ let ``We don't check files that are not depended on`` () = let cacheEvents = ConcurrentQueue() - ProjectWorkflowBuilder(project, useTransparentCompiler = true) { - withChecker (fun checker -> - async { - do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue - }) + ProjectWorkflowBuilder(project, useTransparentCompiler = true) { + withChecker (fun checker -> checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue) updateFile "First" updatePublicSurface checkFile "Last" expectOk } |> ignore @@ -296,7 +306,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" [], @@ -337,7 +347,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" [], @@ -377,36 +387,26 @@ 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 }, { sourceFile "B" ["A"] with SignatureFile = AutoGenerated }, { sourceFile "C" ["B"] with SignatureFile = AutoGenerated }) - let cacheEvents = ConcurrentQueue() + let observe, getEvents = JobEvents.recordAll() ProjectWorkflowBuilder(project, useTransparentCompiler = true) { updateFile "A" updatePublicSurface checkFile "C" expectOk - withChecker (fun checker -> - async { - do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue - }) + withChecker ( observe _.TcIntermediate) updateFile "A" updateInternal checkFile "C" expectOk } |> ignore - let intermediateTypeChecks = - cacheEvents - |> Seq.groupBy (fun (_e, (l, _k, _)) -> l) - |> Seq.map (fun (k, g) -> k, g |> Seq.map fst |> Seq.toList) - |> Seq.toList - - Assert.Equal([], intermediateTypeChecks) + Assert.Empty(getEvents()) -[] +[] let ``Changing impl file doesn't invalidate an in-memory referenced project`` () = let library = SyntheticProject.Create("library", { sourceFile "A" [] with SignatureFile = AutoGenerated }) @@ -414,27 +414,19 @@ let ``Changing impl file doesn't invalidate an in-memory referenced project`` () SyntheticProject.Create("project", sourceFile "B" ["A"] ) with DependsOn = [library] } - let cacheEvents = ConcurrentQueue() + let mutable count = 0 ProjectWorkflowBuilder(project, useTransparentCompiler = true) { checkFile "B" expectOk withChecker (fun checker -> async { - do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.TcIntermediate.OnEvent cacheEvents.Enqueue + checker.Caches.TcIntermediate.OnEvent (fun _ -> Interlocked.Increment &count |> ignore) }) updateFile "A" updateInternal checkFile "B" expectOk } |> ignore - let intermediateTypeChecks = - cacheEvents - |> Seq.groupBy (fun (_e, (l, _k, _)) -> l) - |> Seq.map (fun (k, g) -> k, g |> Seq.map fst |> Seq.toList) - |> Seq.toList - - Assert.Equal([], intermediateTypeChecks) - + Assert.Equal(0, count) [] [] @@ -645,13 +637,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() @@ -789,7 +778,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 @@ -845,61 +834,41 @@ 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" []) + let project = SyntheticProject.CreateForScript( + sourceFile "First" []) - let cacheEvents = ConcurrentQueue() + let observe, getEvents = JobEvents.recordAll() - ProjectWorkflowBuilder(project, useTransparentCompiler = true) { - withChecker (fun checker -> - async { - do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.ScriptClosure.OnEvent cacheEvents.Enqueue - }) + ProjectWorkflowBuilder(project, useTransparentCompiler = true) { + withChecker (observe _.ScriptClosure) + checkFile "First" expectOk + } + |> ignore - checkFile "First" expectOk - } |> ignore - - let closureComputations = - cacheEvents - |> Seq.groupBy (fun (_e, (_l, (f, _p), _)) -> Path.GetFileName f) - |> Seq.map (fun (k, g) -> k, g |> Seq.map fst |> Seq.toList) - |> Map + Assert.Empty(getEvents()) - Assert.Empty(closureComputations) - -[] +[] let ``LoadClosure for script is recomputed after changes`` () = + let project = SyntheticProject.CreateForScript( sourceFile "First" []) - let cacheEvents = ConcurrentQueue() - + let observe, check = JobEvents.record() + ProjectWorkflowBuilder(project, useTransparentCompiler = true) { - withChecker (fun checker -> - async { - do! Async.Sleep 50 // wait for events from initial project check - checker.Caches.ScriptClosure.OnEvent cacheEvents.Enqueue - }) - + withChecker (observe _.ScriptClosure) checkFile "First" expectOk updateFile "First" updateInternal checkFile "First" expectOk updateFile "First" updatePublicSurface checkFile "First" expectOk } |> ignore - - let closureComputations = - cacheEvents - |> Seq.groupBy (fun (_e, (_l, (f, _p), _)) -> Path.GetFileName f) - |> Seq.map (fun (k, g) -> k, g |> Seq.map fst |> Seq.toList) - |> Map - Assert.Equal([Weakened; Requested; Started; Finished; Weakened; Requested; Started; Finished], closureComputations["FileFirst.fs"]) + check "First" [Weakened; Requested; Started; Finished; Weakened; Requested; Started; Finished] -[] +[] let ``TryGetRecentCheckResultsForFile returns None before first call to ParseAndCheckFileInProject`` () = let project = SyntheticProject.Create( sourceFile "First" []) @@ -909,7 +878,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" [] ) @@ -918,7 +887,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" []) @@ -931,7 +900,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" [], @@ -945,9 +914,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") @@ -1012,15 +981,14 @@ printfn "Hello from F#" checkFile "As 01" expectTwoWarnings } -[] +[] 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) = @@ -1064,67 +1032,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..6e220168fef 100644 --- a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FsharpSuiteMigrated.fs +++ b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FsharpSuiteMigrated.fs @@ -31,17 +31,20 @@ 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 s -> - if engine.GetOutput().Contains "TEST PASSED OK" then + | CompilationResult.Success _ -> + if capture.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..1c99df5c311 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 @@ -721,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/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..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)) @@ -479,6 +458,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 +483,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/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/Common.fs b/tests/FSharp.Compiler.Service.Tests/Common.fs index df51f666ccd..0cefad2a646 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) @@ -475,8 +475,8 @@ let assertRange [] module TempDirUtils = - let getTempPath dir = - Path.Combine(Path.GetTempPath(), dir) + let getTempPath dir = + Path.Combine(tempDirectoryOfThisTestRun.Value.FullName, dir) /// Returns the file name part of a temp file name created with tryCreateTemporaryFileName () /// and an added process id and thread id to ensure uniqueness between threads. 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..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,11 +19,13 @@ Never - 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..8f9c4899ca5 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, stdin, stdout, stderr, collectible = true) [] let ``No bound values at the start of FSI session`` () = 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 diff --git a/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/MultiProjectAnalysisTests.fs index 3564288b229..cb0b2248e76 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"] +[] [] [] [] @@ -263,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") @@ -325,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 checker = ManyProjectsStressTest.MakeCheckerForStressTest true 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"] @@ -350,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 wholeProjectResults = checker.ParseAndCheckProject(ManyProjectsStressTest.jointProject.Options) |> Async.RunImmediate + let checker = ManyProjectsStressTest.MakeCheckerForStressTest false useTransparentCompiler + + let wholeProjectResults = checker.ParseAndCheckProject(manyProjectsStressTest.JointProject.Options) |> Async.RunImmediate [ for x in wholeProjectResults.AssemblySignature.Entities -> x.DisplayName ] |> shouldEqual ["JointProject"] @@ -366,11 +376,14 @@ let ``Test ManyProjectsStressTest cache too small`` useTransparentCompiler = [] 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 @@ -388,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() @@ -405,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 () @@ -430,43 +445,51 @@ 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()) |] } [] -// [] +[] [] 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) + + let multiProjectDirty1 = MultiProjectDirty1() + let multiProjectDirty2 = MultiProjectDirty2(multiProjectDirty1) // register to count the file checks - let count = ref 0 - checker.FileChecked.Add (fun _ -> incr count) + let mutable count = 0 + + checker.FileChecked.Add (fun _ -> System.Threading.Interlocked.Increment &count |> ignore) //---------------- 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.Value |> shouldEqual 1 + count |> shouldEqual 1 let backgroundParseResults1, backgroundTypedParse1 = - checker.GetBackgroundCheckResultsForFileInProject(MultiProjectDirty1.fileName1, proj1options) + 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 -------------------- @@ -476,19 +499,19 @@ 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 - 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) - |> 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 @@ -496,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 @@ -506,22 +529,21 @@ 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 - - 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 + 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 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) + checker.GetBackgroundCheckResultsForFileInProject(multiProjectDirty1.FileName1, proj1options) |> Async.RunImmediate let xSymbolUseAfterChange1 = backgroundTypedParse1AfterChange1.GetSymbolUseAtLocation(4, 4, "", ["x"]) @@ -533,11 +555,11 @@ 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) - |> 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 @@ -545,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 @@ -555,29 +577,30 @@ 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 - count.Value |> shouldEqual 4 + System.Threading.Thread.Sleep(1000) + + 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 + 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) + checker.GetBackgroundCheckResultsForFileInProject(multiProjectDirty1.FileName1, proj1options) |> Async.RunImmediate let xSymbolUseAfterChange2 = backgroundTypedParse1AfterChange2.GetSymbolUseAtLocation(4, 4, "", ["x"]) @@ -587,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 @@ -596,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 @@ -829,7 +852,7 @@ let ``Test active patterns' XmlDocSig declared in referenced projects`` useTrans //------------------------------------------------------------------------------------ - +[] [] [] [] 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 diff --git a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs index 5752f9de41c..a4446d633be 100644 --- a/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/ProjectAnalysisTests.fs @@ -1,6 +1,8 @@ -module FSharp.Compiler.Service.Tests.ProjectAnalysisTests +[] +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 @@ -108,6 +110,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 @@ -123,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() - 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`` () = @@ -4406,7 +4403,7 @@ let ``Test Project33 extension methods`` () = ("GetValue", ["member"; "extmem"])] module internal Project34 = - let directoryPath = createTemporaryDirectory "Project34" + let directoryPath = createTemporaryDirectory().FullName let sourceFileName = Path.Combine(directoryPath, "Program.fs") let dllName = Path.ChangeExtension(sourceFileName, ".dll") let projFileName = Path.ChangeExtension(sourceFileName, ".fsproj") @@ -4645,7 +4642,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) @@ -4662,7 +4659,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) @@ -4701,7 +4698,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) @@ -5322,7 +5319,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) @@ -5412,7 +5409,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 = @@ -5498,7 +5495,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 = @@ -5573,7 +5570,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 = @@ -5662,7 +5659,7 @@ type UseTheThings(i:int) = unusedOpensData |> shouldEqual expected [] -// [] // Flaky, reenable when stable +[] // Flaky, reenable when stable [] let ``Unused opens smoke test auto open`` useTransparentCompiler = 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..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 @@ -148,6 +148,7 @@ module LeakUtils = // --------------------------------------------------- +// [] type AsyncModule() = /// Simple asynchronous task that delays 200ms and returns a list of the current tick count @@ -379,23 +380,23 @@ type AsyncModule() = member _.``AwaitWaitHandle.DisposedWaitHandle2``() = let wh = new 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) + use! holder = Async.OnCancel (running.Signal >> ignore) + running.AddCount 1 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 a2a97e4d58c..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 @@ -9,9 +9,18 @@ open FSharp.Test open System.Threading 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 [] 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 1e2fcd58545..ff2c46157db 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..115964702f8 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,23 @@ module rec Compiler = let private compileFSharpCompilation compilation ignoreWarnings (cUnit: CompilationUnit) : CompilationResult = - use redirect = new RedirectConsole() + use capture = new TestConsole.ExecutionCapture() + 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 = capture.OutText; StdErr = capture.ErrorText }) Compilation = cUnit } @@ -733,7 +736,7 @@ module rec Compiler = let outputDirectory = match fs.OutputDirectory with | Some di -> di - | None -> DirectoryInfo(createTemporaryDirectory "compileFSharp") + | None -> createTemporaryDirectory() let references = processReferences fs.References outputDirectory let compilation = Compilation.CreateFromSources([fs.Source] @ fs.AdditionalSources, output, options, fs.TargetFramework, references, name, outputDirectory) compileFSharpCompilation compilation fs.IgnoreWarnings (FS fs) @@ -783,7 +786,7 @@ module rec Compiler = let outputDirectory = match csSource.OutputDirectory with | Some di -> di - | None -> DirectoryInfo(createTemporaryDirectory "compileCSharp") + | None -> createTemporaryDirectory() let additionalReferences = processReferences csSource.References outputDirectory @@ -921,20 +924,18 @@ module rec Compiler = let fileName = fsSource.Source.ChangeExtension.GetSourceFileName let references = - let disposals = ResizeArray() let outputDirectory = match fsSource.OutputDirectory with | Some di -> di - | None -> DirectoryInfo(createTemporaryDirectory "typecheckResults") + | None -> createTemporaryDirectory() let references = processReferences fsSource.References outputDirectory if references.IsEmpty then 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 +982,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 +1002,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 +1014,10 @@ module rec Compiler = let private evalFSharp (fs: FSharpCompilationSource) (script:FSharpScript) : CompilationResult = let source = fs.Source.GetSourceText |> Option.defaultValue "" - script.Eval(source) |> (processScriptResults fs) + use capture = new TestConsole.ExecutionCapture() + let result = script.Eval(source) + let outputWritten, errorsWritten = capture.OutText, capture.ErrorText + processScriptResults fs result outputWritten errorsWritten let scriptingShim = Path.Combine(__SOURCE_DIRECTORY__,"ScriptingShims.fsx") let private evalScriptFromDisk (fs: FSharpCompilationSource) (script:FSharpScript) : CompilationResult = @@ -1027,7 +1029,10 @@ module rec Compiler = |> List.map (sprintf " @\"%s\"") |> String.Concat - script.Eval("#load " + fileNames ) |> (processScriptResults fs) + use capture = new TestConsole.ExecutionCapture() + let result = script.Eval("#load " + fileNames) + let outputWritten, errorsWritten = capture.OutText, capture.ErrorText + processScriptResults fs result outputWritten errorsWritten let eval (cUnit: CompilationUnit) : CompilationResult = match cUnit with @@ -1037,7 +1042,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 +1057,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 -> createTemporaryDirectory() + 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 +1188,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 +1282,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 +1295,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 +1515,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 +1703,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 +1742,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 +1776,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..298aaddac8b 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,65 @@ module rec CompilerAssertHelpers = else entryPoint let args = mkDefaultArgs entryPoint - captureConsoleOutputs (fun () -> entryPoint.Invoke(Unchecked.defaultof, args)) + + use capture = new TestConsole.ExecutionCapture() + let outcome = + try + match entryPoint.Invoke(Unchecked.defaultof, args) with + | :? int as rc -> ExitCode rc + | _ -> NoExitCode + with + | exn -> Failure exn + outcome, capture.OutText, capture.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.install() 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 +439,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 +458,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 +465,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 +528,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 +558,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 +588,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 = createTemporaryDirectory() + 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. @@ -599,47 +599,14 @@ module rec CompilerAssertHelpers = let outputDirectory = match cmpl with | Compilation(outputDirectory = Some outputDirectory) -> DirectoryInfo(outputDirectory.FullName) - | Compilation _ -> DirectoryInfo(createTemporaryDirectory "returnCompilation") + | Compilation _ -> createTemporaryDirectory() outputDirectory.Create() - compileCompilationAux outputDirectory (ResizeArray()) ignoreWarnings cmpl - - let captureConsoleOutputs (func: unit -> obj) = - let out = Console.Out - let err = Console.Error + compileCompilationAux outputDirectory ignoreWarnings cmpl - let stdout = StringBuilder () - let stderr = StringBuilder () + let unwrapException (ex: exn) = ex.InnerException |> Option.ofObj |> Option.map _.Message |> Option.defaultValue ex.Message - use outWriter = new StringWriter (stdout) - use errWriter = new StringWriter (stderr) - - 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 +626,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)) + let output = String.Join(Environment.NewLine, output) + let errors = String.Join(Environment.NewLine, errors) + ExitCode rc, output, errors open CompilerAssertHelpers @@ -678,7 +643,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 +656,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 +678,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 +702,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 ExecuteAux(cmpl: Compilation, ?ignoreWarnings, ?beforeExecute, ?newProcess) = let copyDependenciesToOutputDir (outputFilePath:string) (deps: string list) = let outputDirectory = Path.GetDirectoryName(outputFilePath) @@ -760,24 +721,29 @@ 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 + if newProcess then + executeBuiltAppNewProcess outputFilePath else - let _rc, _stdout, _stderr, exn = executeBuiltApp outputFilePath deps false - exn |> Option.iter raise) + 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, onOutput = (fun output -> Assert.Equal(expectedOutput, output))) + let _, output, _ = CompilerAssert.ExecuteAux(cmpl, newProcess = true) + Assert.Equal(expectedOutput, output) 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 +757,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 +771,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 +802,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 +828,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 +849,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 +872,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 +920,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 +1004,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 +1026,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..f54faec596d 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().FullName 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..fe04b9ed676 100644 --- a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj +++ b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj @@ -10,8 +10,11 @@ true false false + false $(OtherFlags) --warnon:1182 true + + XUNIT_EXTRAS @@ -28,7 +31,9 @@ scriptlib.fsx + + @@ -42,6 +47,10 @@ + + + + @@ -58,6 +67,9 @@ + + + @@ -99,7 +111,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..c55a4afcd1b 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<_, Lazy<_>>() 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,56 @@ type SyntheticProject = this.FrameworkReferences, this.NugetReferences - if not (OptionsCache.ContainsKey cacheKey) then - OptionsCache[cacheKey] <- - use _ = Activity.start "SyntheticProject.GetProjectOptions" [ "project", this.Name ] + let factory _ = + lazy + 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).Value + member this.GetAllProjects() = [ this @@ -951,7 +954,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 +1030,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 +1139,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..aa0593fa090 100644 --- a/tests/FSharp.Test.Utilities/ScriptHelpers.fs +++ b/tests/FSharp.Test.Utilities/ScriptHelpers.fs @@ -24,26 +24,7 @@ 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.ToString() - -type FSharpScript(?additionalArgs: string[], ?quiet: bool, ?langVersion: LangVersion, ?input: string) = +type FSharpScript(?additionalArgs: string[], ?quiet: bool, ?langVersion: LangVersion) = let additionalArgs = defaultArg additionalArgs [||] let quiet = defaultArg quiet true @@ -72,31 +53,12 @@ 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) 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 @@ -127,9 +89,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/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/TestFramework.fs b/tests/FSharp.Test.Utilities/TestFramework.fs index dfde63f2352..a3e0ec7820b 100644 --- a/tests/FSharp.Test.Utilities/TestFramework.fs +++ b/tests/FSharp.Test.Utilities/TestFramework.fs @@ -4,33 +4,33 @@ 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 Xunit let getShortId() = Guid.NewGuid().ToString().[..7] -// Temporary directory is TempPath + "/FSharp.Test.Utilities/yyy-MM-dd-xxxxxxx/" +// Temporary directory is TempPath + "/FSharp.Test.Utilities/xxxxxxx/" let tempDirectoryOfThisTestRun = - let tempDir = Path.GetTempPath() - let today = DateTime.Now.ToString("yyyy-MM-dd") - DirectoryInfo(tempDir) - .CreateSubdirectory($"FSharp.Test.Utilities/{today}-{getShortId()}") - .FullName + let temp = Path.GetTempPath() + lazy DirectoryInfo(temp).CreateSubdirectory($"FSharp.Test.Utilities/{getShortId()}") -let createTemporaryDirectory (part: string) = - DirectoryInfo(tempDirectoryOfThisTestRun) - .CreateSubdirectory($"{part}-{getShortId()}") - .FullName +let cleanUpTemporaryDirectoryOfThisTestRun () = + if tempDirectoryOfThisTestRun.IsValueCreated then + try tempDirectoryOfThisTestRun.Value.Delete(true) with _ -> () + +let createTemporaryDirectory () = + tempDirectoryOfThisTestRun.Value + .CreateSubdirectory($"{getShortId()}") let getTemporaryFileName () = - (createTemporaryDirectory "temp") ++ $"tmp_{getShortId()}" + createTemporaryDirectory().FullName ++ getShortId() let getTemporaryFileNameInDirectory (directory: string) = - directory ++ $"tmp_{getShortId()}" + directory ++ getShortId() // Well, this function is AI generated. let rec copyDirectory (sourceDir: string) (destinationDir: string) (recursive: bool) = @@ -62,7 +62,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 +101,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 +421,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 @@ -474,11 +469,8 @@ let testConfig sourceDir (relativePathToTestFixture: string) = let cfg = suiteHelpers.Value let testFixtureFullPath = Path.GetFullPath(sourceDir ++ relativePathToTestFixture) - let description = relativePathToTestFixture.Split('\\', '/') |> String.concat "-" - - let tempTestRoot = createTemporaryDirectory description let tempTestDir = - DirectoryInfo(tempTestRoot) + createTemporaryDirectory() .CreateSubdirectory(relativePathToTestFixture) .FullName copyDirectory testFixtureFullPath tempTestDir true @@ -487,7 +479,7 @@ let testConfig sourceDir (relativePathToTestFixture: string) = let createConfigWithEmptyDirectory() = let cfg = suiteHelpers.Value - { cfg with Directory = createTemporaryDirectory "temp" } + { cfg with Directory = createTemporaryDirectory().FullName } type RedirectToType = | Overwrite of FilePath @@ -542,7 +534,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 +558,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 +572,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..79eb0363f24 --- /dev/null +++ b/tests/FSharp.Test.Utilities/XunitHelpers.fs @@ -0,0 +1,183 @@ +#if XUNIT_EXTRAS +#nowarn "0044" +#endif + +namespace FSharp.Test + +open System +open Xunit.Sdk +open Xunit.Abstractions + +open TestFramework + +/// 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_EXTRAS +/// 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. + log "FSharpXunitFramework installing TestConsole redirection" + TestConsole.install() + + interface IDisposable with + member _.Dispose() = + cleanUpTemporaryDirectoryOfThisTestRun () + base.Dispose() + +#else + +// 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 + +/// 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) = + task { + use capture = new TestConsole.ExecutionCapture() + let! executionTime = this.BaseInvokeTestMethodAsync aggregator + let output = + seq { + capture.OutText + if not (String.IsNullOrEmpty capture.ErrorText) then + "" + "=========== Standard Error ===========" + "" + capture.ErrorText + } |> String.concat Environment.NewLine + return executionTime, output + } + +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 + +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 + +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 + +/// `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. + log "FSharpXunitFramework with XUNIT_EXTRAS installing TestConsole redirection" + TestConsole.install() + + interface IDisposable with + member _.Dispose() = + cleanUpTemporaryDirectoryOfThisTestRun () + base.Dispose() + + 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) + } + +#endif diff --git a/tests/FSharp.Test.Utilities/XunitSetup.fs b/tests/FSharp.Test.Utilities/XunitSetup.fs new file mode 100644 index 00000000000..1718d7e794f --- /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"