From 2f9772007a5637d2865698b08441e3becee1d715 Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Tue, 4 Jun 2024 23:14:23 +0100 Subject: [PATCH] Support `[]` (#12) --- Consumer/Consumer.fsproj | 1 + Consumer/TestSetUp.fs | 6 +- Consumer/TestValues.fs | 111 ++++++++++++++++ TestRunner/Program.fs | 123 ++++++++++++++---- TestRunner/Seq.fs | 15 +++ TestRunner/TestRunner.Test/TestList.fs | 32 +++++ .../TestRunner.Test/TestRunner.Test.fsproj | 2 + TestRunner/TestRunner.fsproj | 3 +- nix/deps.nix | 5 + 9 files changed, 271 insertions(+), 27 deletions(-) create mode 100644 Consumer/TestValues.fs create mode 100644 TestRunner/Seq.fs create mode 100644 TestRunner/TestRunner.Test/TestList.fs diff --git a/Consumer/Consumer.fsproj b/Consumer/Consumer.fsproj index fa1eddf..7b67032 100644 --- a/Consumer/Consumer.fsproj +++ b/Consumer/Consumer.fsproj @@ -9,6 +9,7 @@ + diff --git a/Consumer/TestSetUp.fs b/Consumer/TestSetUp.fs index 6e09940..3318377 100644 --- a/Consumer/TestSetUp.fs +++ b/Consumer/TestSetUp.fs @@ -23,11 +23,13 @@ module TestSetUp = [] let setUp () = haveOneTimeSetUp.Value |> shouldEqual 1 - Interlocked.Increment setUpTimes |> setUpTimesSeen.Add + let newId = Interlocked.Increment setUpTimes + lock setUpTimesSeen (fun () -> setUpTimesSeen.Add newId) [] let tearDown () = - Interlocked.Increment tearDownTimes |> tearDownTimesSeen.Add + let newId = Interlocked.Increment tearDownTimes + lock tearDownTimesSeen (fun () -> tearDownTimesSeen.Add newId) let haveOneTimeTearDown = ref 0 diff --git a/Consumer/TestValues.fs b/Consumer/TestValues.fs new file mode 100644 index 0000000..7c94969 --- /dev/null +++ b/Consumer/TestValues.fs @@ -0,0 +1,111 @@ +namespace Consumer + +open FsUnitTyped +open NUnit.Framework + +[] +module TestValues = + + let seen1 = ResizeArray () + + [] + let ``Can consume values, single boolean`` ([] x : bool) : unit = + lock seen1 (fun () -> seen1.Add x) + + let seen2 = ResizeArray () + + [] + let ``Can consume values, two bools, sequential, lengths match`` + ([] x : bool, [] y) + : unit + = + lock seen2 (fun () -> seen2.Add (x, y)) + + let seen3 = ResizeArray () + + [] + let ``Can consume values, two ints, sequential, lengths don't match, value type`` + ([] x : int, [] y : int) + : unit + = + lock seen3 (fun () -> seen3.Add (x, box y)) + + let seen4 = ResizeArray () + + [] + let ``Can consume values, two strings, sequential, lengths don't match, reference type`` + ([] x : string, [] y : string) + : unit + = + lock seen4 (fun () -> seen4.Add (x, box y)) + + let seen5 = ResizeArray () + + [] + let ``Can consume values, two ints, combinatorial, lengths don't match, value type`` + ([] x : int, [] y : int) + : unit + = + lock seen5 (fun () -> seen5.Add (x, box y)) + + let seen6 = ResizeArray () + + [] + let ``Can consume values, two strings, combinatorial, lengths don't match, reference type`` + ([] x : string, [] y : string) + : unit + = + lock seen6 (fun () -> seen6.Add (x, box y)) + + let seen7 = ResizeArray () + + [] + let ``Can consume values, two ints, implicit combinatorial, lengths don't match, value type`` + ([] x : int, [] y : int) + : unit + = + lock seen7 (fun () -> seen7.Add (x, box y)) + + let seen8 = ResizeArray () + + [] + let ``Can consume values, two strings, implicit combinatorial, lengths don't match, reference type`` + ([] x : string, [] y : string) + : unit + = + lock seen8 (fun () -> seen8.Add (x, box y)) + + let seen9 = ResizeArray () + + [] + let ``Can consume values, two strings, implicit combinatorial, reference type`` + ([] x : string, [] y : string) + : unit + = + lock seen9 (fun () -> seen9.Add (x, y)) + + [] + let ``Values are all OK`` () = + seen1 |> Seq.toList |> shouldEqual [ true ; false ] + seen2 |> Seq.toList |> shouldEqual [ (true, false) ; (false, true) ] + seen3 |> Seq.toList |> shouldEqual [ (88, 29) ; (31, 0) ] + seen4 |> Seq.toList |> shouldEqual [ ("hi", "ohh") ; ("bye", null) ] + seen5 |> Seq.toList |> shouldEqual [ (88, 29) ; (31, 29) ] + seen6 |> Seq.toList |> shouldEqual [ ("hi", "ohh") ; ("bye", "ohh") ] + seen7 |> Seq.toList |> shouldEqual [ (88, 29) ; (31, 29) ] + seen8 |> Seq.toList |> shouldEqual [ ("hi", "ohh") ; ("bye", "ohh") ] + + seen9 + |> Seq.toList + |> List.sort + |> shouldEqual ( + List.sort + [ + ("hi", "x1") + ("bye", "x1") + ("whoa", "x1") + ("hi", "x2") + ("bye", "x2") + ("whoa", "x2") + ] + ) diff --git a/TestRunner/Program.fs b/TestRunner/Program.fs index bd78d66..3f73d44 100644 --- a/TestRunner/Program.fs +++ b/TestRunner/Program.fs @@ -1,7 +1,6 @@ namespace TestRunner open System -open System.Collections.Generic open System.IO open System.Reflection open System.Threading @@ -16,6 +15,10 @@ type TestKind = | Source of string | Data of obj list list +type Combinatorial = + | Combinatorial + | Sequential + type SingleTestMethod = { // TODO: cope with [] on the parameters @@ -24,6 +27,7 @@ type SingleTestMethod = Modifiers : Modifier list Categories : string list Repeat : int option + Combinatorial : Combinatorial option } member this.Name = this.Method.Name @@ -31,26 +35,27 @@ type SingleTestMethod = [] module SingleTestMethod = let parse (parentCategories : string list) (method : MethodInfo) : SingleTestMethod option = - let isTest, hasSource, hasData, modifiers, categories, repeat = - ((false, None, None, [], [], None), method.CustomAttributes) - ||> Seq.fold (fun (isTest, hasSource, hasData, mods, cats, repeat) attr -> + let isTest, hasSource, hasData, modifiers, categories, repeat, comb = + ((false, None, None, [], [], None, None), method.CustomAttributes) + ||> Seq.fold (fun (isTest, hasSource, hasData, mods, cats, repeat, comb) attr -> match attr.AttributeType.FullName with | "NUnit.Framework.TestAttribute" -> if attr.ConstructorArguments.Count > 0 then failwith "Unexpectedly got arguments to the Test attribute" - (true, hasSource, hasData, mods, cats, repeat) + (true, hasSource, hasData, mods, cats, repeat, comb) | "NUnit.Framework.TestCaseAttribute" -> let args = attr.ConstructorArguments |> Seq.map _.Value |> Seq.toList match hasData with - | None -> (isTest, hasSource, Some [ List.ofSeq args ], mods, cats, repeat) - | Some existing -> (isTest, hasSource, Some ((List.ofSeq args) :: existing), mods, cats, repeat) + | None -> (isTest, hasSource, Some [ List.ofSeq args ], mods, cats, repeat, comb) + | Some existing -> + (isTest, hasSource, Some ((List.ofSeq args) :: existing), mods, cats, repeat, comb) | "NUnit.Framework.TestCaseSourceAttribute" -> let arg = attr.ConstructorArguments |> Seq.exactlyOne |> _.Value |> unbox match hasSource with - | None -> (isTest, Some arg, hasData, mods, cats, repeat) + | None -> (isTest, Some arg, hasData, mods, cats, repeat, comb) | Some existing -> failwith $"Unexpectedly got multiple different sources for test %s{method.Name} (%s{existing}, %s{arg})" @@ -60,63 +65,76 @@ module SingleTestMethod = |> Seq.tryHead |> Option.map (_.Value >> unbox) - (isTest, hasSource, hasData, (Modifier.Explicit reason) :: mods, cats, repeat) + (isTest, hasSource, hasData, (Modifier.Explicit reason) :: mods, cats, repeat, comb) | "NUnit.Framework.IgnoreAttribute" -> let reason = attr.ConstructorArguments |> Seq.tryHead |> Option.map (_.Value >> unbox) - (isTest, hasSource, hasData, (Modifier.Ignored reason) :: mods, cats, repeat) + (isTest, hasSource, hasData, (Modifier.Ignored reason) :: mods, cats, repeat, comb) | "NUnit.Framework.CategoryAttribute" -> let category = attr.ConstructorArguments |> Seq.exactlyOne |> _.Value |> unbox - (isTest, hasSource, hasData, mods, category :: cats, repeat) + (isTest, hasSource, hasData, mods, category :: cats, repeat, comb) | "NUnit.Framework.RepeatAttribute" -> match repeat with | Some _ -> failwith $"Got RepeatAttribute multiple times on %s{method.Name}" | None -> let repeat = attr.ConstructorArguments |> Seq.exactlyOne |> _.Value |> unbox - (isTest, hasSource, hasData, mods, cats, Some repeat) + (isTest, hasSource, hasData, mods, cats, Some repeat, comb) + | "NUnit.Framework.CombinatorialAttribute" -> + match comb with + | Some _ -> + failwith $"Got CombinatorialAttribute or SequentialAttribute multiple times on %s{method.Name}" + | None -> (isTest, hasSource, hasData, mods, cats, repeat, Some Combinatorial.Combinatorial) + | "NUnit.Framework.SequentialAttribute" -> + match comb with + | Some _ -> + failwith $"Got CombinatorialAttribute or SequentialAttribute multiple times on %s{method.Name}" + | None -> (isTest, hasSource, hasData, mods, cats, repeat, Some Combinatorial.Sequential) | s when s.StartsWith ("NUnit.Framework", StringComparison.Ordinal) -> failwith $"Unrecognised attribute on function %s{method.Name}: %s{attr.AttributeType.FullName}" - | _ -> (isTest, hasSource, hasData, mods, cats, repeat) + | _ -> (isTest, hasSource, hasData, mods, cats, repeat, comb) ) - match isTest, hasSource, hasData, modifiers, categories, repeat with - | _, Some _, Some _, _, _, _ -> + match isTest, hasSource, hasData, modifiers, categories, repeat, comb with + | _, Some _, Some _, _, _, _, _ -> failwith $"Test %s{method.Name} unexpectedly has both TestData and TestCaseSource; not currently supported" - | false, None, None, [], _, _ -> None - | _, Some source, None, mods, categories, repeat -> + | false, None, None, [], _, _, _ -> None + | _, Some source, None, mods, categories, repeat, comb -> { Kind = TestKind.Source source Method = method Modifiers = mods Categories = categories @ parentCategories Repeat = repeat + Combinatorial = comb } |> Some - | _, None, Some data, mods, categories, repeat -> + | _, None, Some data, mods, categories, repeat, comb -> { Kind = TestKind.Data data Method = method Modifiers = mods Categories = categories @ parentCategories Repeat = repeat + Combinatorial = comb } |> Some - | true, None, None, mods, categories, repeat -> + | true, None, None, mods, categories, repeat, comb -> { Kind = TestKind.Single Method = method Modifiers = mods Categories = categories @ parentCategories Repeat = repeat + Combinatorial = comb } |> Some - | false, None, None, _ :: _, _, _ -> + | false, None, None, _ :: _, _, _, _ -> failwith $"Unexpectedly got test modifiers but no test settings on '%s{method.Name}', which you probably didn't intend." @@ -211,12 +229,69 @@ module TestFixture = Seq.init (Option.defaultValue 1 test.Repeat) (fun _ -> - match test.Kind with - | TestKind.Data data -> + let valuesAttrs = + test.Method.GetParameters () + |> Array.map (fun i -> + i.CustomAttributes + |> Seq.choose (fun i -> + if i.AttributeType.FullName = "NUnit.Framework.ValuesAttribute" then + Some i.ConstructorArguments + else + None + ) + |> Seq.toList + |> function + | [] -> None + | [ x ] -> Some x + | _ :: _ :: _ -> + failwith + $"Test %s{test.Name} has multiple Values attributes on a parameter. Exactly one per parameter please." + ) + + let valuesAttrs = + if valuesAttrs |> Array.exists (fun l -> l.IsSome) then + if valuesAttrs |> Array.exists (fun l -> l.IsNone) then + failwith + $"Test %s{test.Name} has a parameter with the Values attribute and a parameter without. All parameters must have Values if any one does." + + Choice1Of2 (valuesAttrs |> Array.map Option.get) + else + Choice2Of2 () + + match test.Kind, valuesAttrs with + | TestKind.Data data, Choice2Of2 () -> data |> Seq.map (fun args -> runOne setUp tearDown test.Method (Array.ofList args)) - | TestKind.Single -> Seq.singleton (runOne setUp tearDown test.Method [||]) - | TestKind.Source s -> + | TestKind.Data _, Choice1Of2 _ -> + failwith + $"Test %s{test.Name} has both the TestCase and Values attributes. Specify one or the other." + | TestKind.Single, Choice2Of2 () -> Seq.singleton (runOne setUp tearDown test.Method [||]) + | TestKind.Single, Choice1Of2 vals -> + let combinatorial = + Option.defaultValue Combinatorial.Combinatorial test.Combinatorial + + match combinatorial with + | Combinatorial.Combinatorial -> + vals + |> Seq.map (fun l -> l |> Seq.map (fun v -> v.Value) |> Seq.toList) + |> Seq.toList + |> List.combinations + |> Seq.map (fun args -> runOne setUp tearDown test.Method (Array.ofList args)) + | Combinatorial.Sequential -> + let maxLength = vals |> Seq.map (fun i -> i.Count) |> Seq.max + + seq { + for i = 0 to maxLength - 1 do + let args = + vals + |> Array.map (fun param -> if i >= param.Count then null else param.[i].Value) + + runOne setUp tearDown test.Method args + } + | TestKind.Source _, Choice1Of2 _ -> + failwith + $"Test %s{test.Name} has both the TestCaseSource and Values attributes. Specify one or the other." + | TestKind.Source s, Choice2Of2 () -> let args = test.Method.DeclaringType.GetProperty ( s, diff --git a/TestRunner/Seq.fs b/TestRunner/Seq.fs new file mode 100644 index 0000000..4c723ae --- /dev/null +++ b/TestRunner/Seq.fs @@ -0,0 +1,15 @@ +namespace TestRunner + +[] +module List = + + /// Given e.g. [[1,2],[4,5,6]], returns: + /// [1;4] ; [1;5] ; [1;6] ; [2;4] ; [2;5] ; [2;6] + /// in some order. + /// This is like allPairs but more so. + let rec combinations (s : 'a list list) : 'a list list = + match s with + | [] -> [ [] ] + | head :: s -> + let sub = combinations s + head |> List.collect (fun head -> sub |> List.map (fun tail -> head :: tail)) diff --git a/TestRunner/TestRunner.Test/TestList.fs b/TestRunner/TestRunner.Test/TestList.fs new file mode 100644 index 0000000..37d75d9 --- /dev/null +++ b/TestRunner/TestRunner.Test/TestList.fs @@ -0,0 +1,32 @@ +namespace TestRunner.Test + +open FsCheck +open FsUnitTyped +open TestRunner +open NUnit.Framework + +[] +module TestList = + + [] + let ``combinations has right size`` () = + let property (xs : int list list) = + let combs = List.combinations xs + + combs.Length + |> shouldEqual ((1, xs) ||> List.fold (fun acc l -> acc * l.Length)) + + Check.QuickThrowOnFailure property + + [] + let ``each combination is drawn from the right set`` () = + let property (xs : int list list) = + let combs = List.combinations xs + + for comb in combs do + comb.Length |> shouldEqual xs.Length + + for i = 0 to comb.Length - 1 do + xs.[i] |> shouldContain comb.[i] + + Check.QuickThrowOnFailure property diff --git a/TestRunner/TestRunner.Test/TestRunner.Test.fsproj b/TestRunner/TestRunner.Test/TestRunner.Test.fsproj index a19b985..093f7be 100644 --- a/TestRunner/TestRunner.Test/TestRunner.Test.fsproj +++ b/TestRunner/TestRunner.Test/TestRunner.Test.fsproj @@ -9,9 +9,11 @@ + + diff --git a/TestRunner/TestRunner.fsproj b/TestRunner/TestRunner.fsproj index 3a9bffa..8945f57 100644 --- a/TestRunner/TestRunner.fsproj +++ b/TestRunner/TestRunner.fsproj @@ -1,4 +1,4 @@ - + Exe @@ -7,6 +7,7 @@ + diff --git a/nix/deps.nix b/nix/deps.nix index 4a5e161..bbff077 100644 --- a/nix/deps.nix +++ b/nix/deps.nix @@ -6,6 +6,11 @@ version = "6.3.7"; sha256 = "1z1a5bw7vwz6g8nvfgkvx66jnm4hmvn62vbyq0as60nw0jlvaidl"; }) + (fetchNuGet { + pname = "FsCheck"; + version = "3.0.0-rc3"; + sha256 = "1rn4x9qh479927viwww3dy0mikcdcq3pfqv1hzbbawnwxfzm17z1"; + }) (fetchNuGet { pname = "fsharp-analyzers"; version = "0.26.0";