Support [<Values>] (#12)

Consumer/Consumer.fsproj

@@ -9,6 +9,7 @@
 
     <ItemGroup>
         <Compile Include="TestSetUp.fs" />
+        <Compile Include="TestValues.fs" />
     </ItemGroup>
 
     <ItemGroup>

Consumer/TestSetUp.fs

@@ -23,11 +23,13 @@ module TestSetUp =
     [<SetUp>]
     let setUp () =
         haveOneTimeSetUp.Value |> shouldEqual 1
-        Interlocked.Increment setUpTimes |> setUpTimesSeen.Add
+        let newId = Interlocked.Increment setUpTimes
+        lock setUpTimesSeen (fun () -> setUpTimesSeen.Add newId)
 
     [<TearDown>]
     let tearDown () =
-        Interlocked.Increment tearDownTimes |> tearDownTimesSeen.Add
+        let newId = Interlocked.Increment tearDownTimes
+        lock tearDownTimesSeen (fun () -> tearDownTimesSeen.Add newId)
 
     let haveOneTimeTearDown = ref 0
 

Consumer/TestValues.fs

@@ -0,0 +1,111 @@
+namespace Consumer
+
+open FsUnitTyped
+open NUnit.Framework
+
+[<TestFixture>]
+module TestValues =
+
+    let seen1 = ResizeArray<bool> ()
+
+    [<Test>]
+    let ``Can consume values, single boolean`` ([<Values(true, false)>] x : bool) : unit =
+        lock seen1 (fun () -> seen1.Add x)
+
+    let seen2 = ResizeArray ()
+
+    [<Test ; Sequential>]
+    let ``Can consume values, two bools, sequential, lengths match``
+        ([<Values(true, false)>] x : bool, [<Values(false, true)>] y)
+        : unit
+        =
+        lock seen2 (fun () -> seen2.Add (x, y))
+
+    let seen3 = ResizeArray<int * obj> ()
+
+    [<Test ; Sequential>]
+    let ``Can consume values, two ints, sequential, lengths don't match, value type``
+        ([<Values(88, 31)>] x : int, [<Values 29>] y : int)
+        : unit
+        =
+        lock seen3 (fun () -> seen3.Add (x, box y))
+
+    let seen4 = ResizeArray<string * obj> ()
+
+    [<Test ; Sequential>]
+    let ``Can consume values, two strings, sequential, lengths don't match, reference type``
+        ([<Values("hi", "bye")>] x : string, [<Values "ohh">] y : string)
+        : unit
+        =
+        lock seen4 (fun () -> seen4.Add (x, box y))
+
+    let seen5 = ResizeArray<int * obj> ()
+
+    [<Test ; Combinatorial>]
+    let ``Can consume values, two ints, combinatorial, lengths don't match, value type``
+        ([<Values(88, 31)>] x : int, [<Values 29>] y : int)
+        : unit
+        =
+        lock seen5 (fun () -> seen5.Add (x, box y))
+
+    let seen6 = ResizeArray<string * obj> ()
+
+    [<Test ; Combinatorial>]
+    let ``Can consume values, two strings, combinatorial, lengths don't match, reference type``
+        ([<Values("hi", "bye")>] x : string, [<Values "ohh">] y : string)
+        : unit
+        =
+        lock seen6 (fun () -> seen6.Add (x, box y))
+
+    let seen7 = ResizeArray<int * obj> ()
+
+    [<Test>]
+    let ``Can consume values, two ints, implicit combinatorial, lengths don't match, value type``
+        ([<Values(88, 31)>] x : int, [<Values 29>] y : int)
+        : unit
+        =
+        lock seen7 (fun () -> seen7.Add (x, box y))
+
+    let seen8 = ResizeArray<string * obj> ()
+
+    [<Test>]
+    let ``Can consume values, two strings, implicit combinatorial, lengths don't match, reference type``
+        ([<Values("hi", "bye")>] x : string, [<Values "ohh">] y : string)
+        : unit
+        =
+        lock seen8 (fun () -> seen8.Add (x, box y))
+
+    let seen9 = ResizeArray<string * string> ()
+
+    [<Test>]
+    let ``Can consume values, two strings, implicit combinatorial, reference type``
+        ([<Values("hi", "bye", "whoa")>] x : string, [<Values("x1", "x2")>] y : string)
+        : unit
+        =
+        lock seen9 (fun () -> seen9.Add (x, y))
+
+    [<OneTimeTearDown>]
+    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")
+                ]
+        )

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 [<Values>] 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 =
 [<RequireQualifiedAccess>]
 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<string>
 
                     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<string>)
 
-                    (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<string>)
 
-                    (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<string>
 
-                    (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<int>
-                    (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,

TestRunner/Seq.fs

@@ -0,0 +1,15 @@
+namespace TestRunner
+
+[<RequireQualifiedAccess>]
+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))

TestRunner/TestRunner.Test/TestList.fs

@@ -0,0 +1,32 @@
+namespace TestRunner.Test
+
+open FsCheck
+open FsUnitTyped
+open TestRunner
+open NUnit.Framework
+
+[<TestFixture>]
+module TestList =
+
+    [<Test>]
+    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
+
+    [<Test>]
+    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

TestRunner/TestRunner.Test/TestRunner.Test.fsproj

@@ -9,9 +9,11 @@
 
     <ItemGroup>
         <Compile Include="TestFilter.fs" />
+        <Compile Include="TestList.fs" />
     </ItemGroup>
 
     <ItemGroup>
+        <PackageReference Include="FsCheck" Version="3.0.0-rc3" />
         <PackageReference Include="FsUnit" Version="6.0.0" />
         <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.10.0" />
         <PackageReference Include="NUnit" Version="4.1.0" />

TestRunner/TestRunner.fsproj

@@ -1,4 +1,4 @@
-<Project Sdk="Microsoft.NET.Sdk">
+<Project Sdk="Microsoft.NET.Sdk">
 
   <PropertyGroup>
     <OutputType>Exe</OutputType>
@@ -7,6 +7,7 @@
 
   <ItemGroup>
     <Compile Include="Filter.fs" />
+    <Compile Include="Seq.fs" />
     <Compile Include="Program.fs" />
   </ItemGroup>
 

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";