Async tests (#280)

This commit is contained in:
Patrick Stevens
2025-07-30 00:07:12 +01:00
committed by GitHub
parent eeada219f6
commit fcfdcef6cf
3 changed files with 176 additions and 87 deletions

View File

@@ -10,6 +10,7 @@
<Compile Include="NoAttribute.fs" />
<Compile Include="Inconclusive.fs" />
<Compile Include="RunSubProcess.fs" />
<Compile Include="TestAsync.fs" />
<Compile Include="TestExplicit.fs" />
<Compile Include="TestNonParallel.fs" />
<Compile Include="TestParallel.fs" />

23
Consumer/TestAsync.fs Normal file
View File

@@ -0,0 +1,23 @@
namespace Consumer
open System
open System.Threading.Tasks
open FsUnitTyped
open NUnit.Framework
[<TestFixture>]
module TestAsync =
[<Test>]
let ``an async test`` () =
async {
do! Async.Sleep (TimeSpan.FromMilliseconds 20.0)
1 |> shouldEqual 1
}
[<Test>]
let ``an async test, task-based`` () =
task {
do! Task.Delay (TimeSpan.FromMilliseconds 20.0)
1 |> shouldEqual 1
}

View File

@@ -76,22 +76,24 @@ module TestFixture =
(test : MethodInfo)
(containingObject : obj)
(args : obj[])
: Result<TestMemberSuccess, TestFailure list> * IndividualTestRunMetadata
: Async<Result<TestMemberSuccess, TestFailure list> * IndividualTestRunMetadata>
=
let rec runMethods
(wrap : UserMethodFailure -> TestFailure)
(toRun : MethodInfo list)
(args : obj[])
: Result<unit, _>
: Result<unit, TestFailure> Async
=
match toRun with
| [] -> Ok ()
| [] -> async.Return (Ok ())
| head :: rest ->
async {
let result =
try
head.Invoke (containingObject, args) |> Ok
with
| :? TargetInvocationException as e -> Error (UserMethodFailure.Threw (head.Name, e.InnerException))
| :? TargetInvocationException as e ->
Error (UserMethodFailure.Threw (head.Name, e.InnerException))
| :? TargetParameterCountException ->
UserMethodFailure.BadParameters (
head.Name,
@@ -100,13 +102,72 @@ module TestFixture =
)
|> Error
let! ct = Async.CancellationToken
let! result =
match result with
| Error e -> Error (wrap e)
| Error e -> async.Return (Error (wrap e))
| Ok result ->
match result with
| :? unit -> runMethods wrap rest args
| ret -> UserMethodFailure.ReturnedNonUnit (head.Name, ret) |> wrap |> Error
| :? Task as result ->
async {
let mutable exc = None
try
do! Async.AwaitTask result
with e ->
exc <- Some e
match exc with
| None -> return! runMethods wrap rest args
| Some e -> return Error (UserMethodFailure.Threw (head.Name, e) |> wrap)
}
// We'd like to do this type-test:
// | :? Async<unit> as result ->
// but instead we have to do all this reflective nonsense, because FSharpAsync is not part
// of the .NET runtime, so is instead in a different AssemblyLoadContext to us!
// It's in the user-code context, not ours.
| ret ->
let ty = ret.GetType ()
if ty.Namespace = "Microsoft.FSharp.Control" && ty.Name = "FSharpAsync`1" then
match ty.GenericTypeArguments |> Array.map (fun t -> t.FullName) with
| [| "Microsoft.FSharp.Core.Unit" |] ->
let asyncModule = ty.Assembly.GetType ("Microsoft.FSharp.Control.FSharpAsync")
// let catch = asyncModule.GetMethod("Catch").MakeGenericMethod [| ty.GenericTypeArguments.[0] |]
// let caught = catch.Invoke ((null: obj), [| ret |])
let startAsTask =
asyncModule.GetMethod("StartAsTask").MakeGenericMethod
[| ty.GenericTypeArguments.[0] |]
let started =
startAsTask.Invoke ((null : obj), [| ret ; (null : obj) ; (null : obj) |])
|> unbox<Task>
async {
let! res = Async.AwaitTask started |> Async.Catch
match res with
| Choice1Of2 () -> return! runMethods wrap rest args
| Choice2Of2 e ->
return
Error (
UserMethodFailure.Threw (head.Name, started.Exception) |> wrap
)
}
| _ ->
UserMethodFailure.ReturnedNonUnit (head.Name, ret)
|> wrap
|> Error
|> async.Return
else
async.Return (UserMethodFailure.ReturnedNonUnit (head.Name, ret) |> wrap |> Error)
return result
}
async {
let start = DateTimeOffset.Now
let sw = Stopwatch.StartNew ()
@@ -138,25 +199,25 @@ module TestFixture =
| v -> Some v
}
let setUpResult = runMethods TestFailure.SetUpFailed setUp [||]
let! setUpResult = runMethods TestFailure.SetUpFailed setUp [||]
sw.Stop ()
match setUpResult with
| Error e -> Error [ e ], metadata ()
| Error e -> return Error [ e ], metadata ()
| Ok () ->
sw.Start ()
let result =
let result = runMethods TestFailure.TestFailed [ test ] args
let! result = runMethods TestFailure.TestFailed [ test ] args
sw.Stop ()
let result =
match result with
| Ok () -> Ok None
| Error (TestFailure.TestFailed (UserMethodFailure.Threw (_, exc)) as orig) ->
match exc.GetType().FullName with
| "NUnit.Framework.SuccessException" -> Ok None
| "NUnit.Framework.IgnoreException" -> Ok (Some (TestMemberSuccess.Ignored (Option.ofObj exc.Message)))
| "NUnit.Framework.IgnoreException" ->
Ok (Some (TestMemberSuccess.Ignored (Option.ofObj exc.Message)))
| "NUnit.Framework.InconclusiveException" ->
Ok (Some (TestMemberSuccess.Inconclusive (Option.ofObj exc.Message)))
| _ -> Error orig
@@ -164,17 +225,19 @@ module TestFixture =
// Unconditionally run TearDown after tests, even if tests failed.
sw.Start ()
let tearDownResult = runMethods TestFailure.TearDownFailed tearDown [||]
let! tearDownResult = runMethods TestFailure.TearDownFailed tearDown [||]
sw.Stop ()
let metadata = metadata ()
return
match result, tearDownResult with
| Ok None, Ok () -> Ok TestMemberSuccess.Ok, metadata
| Ok (Some s), Ok () -> Ok s, metadata
| Error e, Ok ()
| Ok _, Error e -> Error [ e ], metadata
| Error e1, Error e2 -> Error [ e1 ; e2 ], metadata
}
let private getValues (test : SingleTestMethod) =
let valuesAttrs =
@@ -395,20 +458,22 @@ module TestFixture =
|> Seq.map (fun (testGuid, args) ->
task {
let runMe () =
async {
progress.OnTestMemberStart test.Name
let oldValue = contexts.AsyncLocal.Value
let outputId = contexts.NewOutputs ()
contexts.AsyncLocal.Value <- outputId
let result, meta =
let! result, meta =
runOne outputId contexts setUp tearDown testGuid test.Method containingObject args
contexts.AsyncLocal.Value <- oldValue
progress.OnTestMemberFinished test.Name
result, meta
return result, meta
}
let! results, summary = par.Run running test.Parallelize runMe
let! results, summary = par.RunAsync running test.Parallelize runMe
match results with
| Ok results -> return Ok results, summary