Filter parsing

Filter.fs

@@ -0,0 +1,224 @@
+namespace TestRunner
+
+open System
+open PrattParser
+
+// Documentation:
+// https://learn.microsoft.com/en-us/dotnet/core/testing/selective-unit-tests?pivots=mstest
+
+[<RequireQualifiedAccess>]
+type FilterIntermediate =
+    | FullyQualifiedName
+    | Name
+    | TestCategory
+    | Not of FilterIntermediate
+    | Or of FilterIntermediate * FilterIntermediate
+    | And of FilterIntermediate * FilterIntermediate
+    | Equal of FilterIntermediate * FilterIntermediate
+    | Contains of FilterIntermediate * FilterIntermediate
+    | String of string
+
+[<RequireQualifiedAccess>]
+type TokenType =
+    | FullyQualifiedName
+    | Name
+    | TestCategory
+    | OpenParen
+    | CloseParen
+    | And
+    | Or
+    | Not
+    | Equal
+    | NotEqual
+    | Contains
+    | NotContains
+    | String
+
+type Token =
+    {
+        Type : TokenType
+        Trivia : int * int
+    }
+
+[<RequireQualifiedAccess>]
+module Token =
+    let inline standalone (ty : TokenType) (charPos : int) : Token =
+        {
+            Type = ty
+            Trivia = charPos, 1
+        }
+
+    let inline single (ty : TokenType) (start : int) (len : int) : Token =
+        {
+            Type = ty
+            Trivia = start, len
+        }
+
+    let (|SingleChar|_|) (i : int, c : char) : Token option =
+        match c with
+        | '(' -> Some (standalone TokenType.OpenParen i)
+        | ')' -> Some (standalone TokenType.CloseParen i)
+        | '~' -> Some (standalone TokenType.Contains i)
+        | '=' -> Some (standalone TokenType.Equal i)
+        | '&' -> Some (standalone TokenType.And i)
+        | '|' -> Some (standalone TokenType.Or i)
+        | '!' -> Some (standalone TokenType.Not i)
+        | _ -> None
+
+[<RequireQualifiedAccess>]
+module Lexer =
+    let lex (s : string) : Token seq =
+        seq {
+            let mutable i = 0
+            let mutable stringAcc : int option = None
+
+            while i < s.Length do
+                match (i, s.[i]), stringAcc with
+                // This one has to come before the check for prefix Not
+                | (startI, '!'), None when i + 1 < s.Length ->
+                    i <- i + 1
+
+                    match s.[i] with
+                    | '~' ->
+                        yield Token.single TokenType.NotContains startI 2
+                        i <- i + 1
+                    | '=' ->
+                        yield Token.single TokenType.NotEqual startI 2
+                        i <- i + 1
+                    | _ ->
+                        yield Token.single TokenType.Not startI 1
+                        i <- i + 1
+                | Token.SingleChar token, None ->
+                    i <- i + 1
+                    yield token
+                | Token.SingleChar _, Some stringStart ->
+                    yield Token.single TokenType.String stringStart (i - stringStart)
+                    stringAcc <- None // and we'll do the match again
+                | (_, 'F'), None when
+                    i + 1 < s.Length
+                    && s.[i + 1 ..].StartsWith ("ullyQualifiedName", StringComparison.Ordinal)
+                    ->
+                    yield Token.single TokenType.FullyQualifiedName i "FullyQualifiedName".Length
+                    i <- i + "FullyQualifiedName".Length
+                | (_, 'N'), None when i + 1 < s.Length && s.[i + 1 ..].StartsWith ("ame", StringComparison.Ordinal) ->
+                    yield Token.single TokenType.Name i "Name".Length
+                    i <- i + "Name".Length
+                | (_, 'T'), None when
+                    i + 1 < s.Length
+                    && s.[i + 1 ..].StartsWith ("estCategory", StringComparison.Ordinal)
+                    ->
+                    yield Token.single TokenType.TestCategory i "TestCategory".Length
+                    i <- i + "TestCategory".Length
+                | (_, ' '), None -> i <- i + 1
+                | (_, _), None ->
+                    stringAcc <- Some i
+                    i <- i + 1
+                | (_, _), Some _ -> i <- i + 1
+
+            match stringAcc with
+            | None -> ()
+            | Some start -> yield Token.single TokenType.String start (s.Length - start)
+        }
+
+[<RequireQualifiedAccess>]
+module FilterIntermediate =
+    let private atom (inputString : string) (token : Token) : FilterIntermediate option =
+        let start, len = token.Trivia
+
+        match token.Type with
+        | TokenType.String -> Some (FilterIntermediate.String (inputString.Substring (start, len)))
+        | TokenType.FullyQualifiedName -> Some FilterIntermediate.FullyQualifiedName
+        | TokenType.Name -> Some FilterIntermediate.Name
+        | TokenType.TestCategory -> Some FilterIntermediate.TestCategory
+        | TokenType.OpenParen -> None
+        | TokenType.CloseParen -> None
+        | TokenType.And -> None
+        | TokenType.Or -> None
+        | TokenType.Not -> None
+        | TokenType.NotEqual -> None
+        | TokenType.Equal -> None
+        | TokenType.NotContains -> None
+        | TokenType.Contains -> None
+
+    let parser =
+        Parser.make<_, Token, FilterIntermediate> _.Type atom
+        |> Parser.withInfix TokenType.And (10, 11) (fun a b -> FilterIntermediate.And (a, b))
+        |> Parser.withInfix TokenType.Equal (15, 16) (fun a b -> FilterIntermediate.Equal (a, b))
+        |> Parser.withInfix
+            TokenType.NotEqual
+            (15, 16)
+            (fun a b -> FilterIntermediate.Not (FilterIntermediate.Equal (a, b)))
+        |> Parser.withInfix TokenType.Contains (15, 16) (fun a b -> FilterIntermediate.Contains (a, b))
+        |> Parser.withInfix
+            TokenType.NotContains
+            (15, 16)
+            (fun a b -> FilterIntermediate.Not (FilterIntermediate.Contains (a, b)))
+        |> Parser.withInfix TokenType.Or (5, 6) (fun a b -> FilterIntermediate.Or (a, b))
+        |> Parser.withUnaryPrefix TokenType.Not ((), 13) FilterIntermediate.Not
+        |> Parser.withBracketLike
+            TokenType.OpenParen
+            {
+                ConsumeBeforeInitialToken = false
+                ConsumeAfterFinalToken = false
+                BoundaryTokens = [ TokenType.CloseParen ]
+                Construct = Seq.exactlyOne
+            }
+
+    let parse (s : string) : FilterIntermediate =
+        let parsed, remaining = Parser.execute parser s (Lexer.lex s |> Seq.toList)
+
+        if not remaining.IsEmpty then
+            failwith $"Leftover tokens: %O{remaining}"
+
+        match parsed with
+        | FilterIntermediate.String _ -> FilterIntermediate.Contains (FilterIntermediate.FullyQualifiedName, parsed)
+        | _ -> parsed
+
+type Match =
+    | Exact of string
+    | Contains of string
+
+[<RequireQualifiedAccess>]
+type Filter =
+    | FullyQualifiedName of Match
+    | Name of Match
+    | TestCategory of Match
+    | Not of Filter
+    | Or of Filter * Filter
+    | And of Filter * Filter
+
+[<RequireQualifiedAccess>]
+module Filter =
+    let rec make (fi : FilterIntermediate) : Filter =
+        match fi with
+        | FilterIntermediate.Not x -> Filter.Not (make x)
+        | FilterIntermediate.FullyQualifiedName -> failwith "malformed filter: found FullyQualifiedName with no operand"
+        | FilterIntermediate.Name -> failwith "malformed filter: found Name with no operand"
+        | FilterIntermediate.TestCategory -> failwith "malformed filter: found TestCategory with no operand"
+        | FilterIntermediate.Or (a, b) -> Filter.Or (make a, make b)
+        | FilterIntermediate.And (a, b) -> Filter.And (make a, make b)
+        | FilterIntermediate.Equal (key, value) ->
+            let value =
+                match value with
+                | FilterIntermediate.String s -> s
+                | _ -> failwith $"malformed filter: found non-string operand on RHS of equality, '%O{value}'"
+
+            match key with
+            | FilterIntermediate.TestCategory -> Filter.TestCategory (Match.Exact value)
+            | FilterIntermediate.FullyQualifiedName -> Filter.FullyQualifiedName (Match.Exact value)
+            | FilterIntermediate.Name -> Filter.Name (Match.Exact value)
+            | _ -> failwith $"Malformed filter: left-hand side of Equals clause must be e.g. TestCategory, was %O{key}"
+        | FilterIntermediate.Contains (key, value) ->
+            let value =
+                match value with
+                | FilterIntermediate.String s -> s
+                | _ -> failwith $"malformed filter: found non-string operand on RHS of containment, '%O{value}'"
+
+            match key with
+            | FilterIntermediate.TestCategory -> Filter.TestCategory (Match.Contains value)
+            | FilterIntermediate.FullyQualifiedName -> Filter.FullyQualifiedName (Match.Contains value)
+            | FilterIntermediate.Name -> Filter.Name (Match.Contains value)
+            | _ ->
+                failwith $"Malformed filter: left-hand side of Contains clause must be e.g. TestCategory, was %O{key}"
+        | FilterIntermediate.String s ->
+            failwith $"Malformed filter: got verbatim string %s{s} when expected an operation"

Program.fs

@@ -18,6 +18,7 @@ type TestKind =
 
 type SingleTestMethod =
     {
+        // TODO: cope with [<Values>] on the parameters
         Method : MethodInfo
         Kind : TestKind
         Modifiers : Modifier list
@@ -94,16 +95,16 @@ module SingleTestMethod =
 type TestFixture =
     {
         Name : string
-        SetUp : MethodInfo option
-        TearDown : MethodInfo option
+        OneTimeSetUp : MethodInfo option
+        OneTimeTearDown : MethodInfo option
         Tests : SingleTestMethod list
     }
 
     static member Empty (name : string) =
         {
             Name = name
-            SetUp = None
-            TearDown = None
+            OneTimeSetUp = None
+            OneTimeTearDown = None
             Tests = []
         }
 
@@ -168,7 +169,7 @@ module TestFixture =
     let run (tests : TestFixture) : int =
         eprintfn $"Running test fixture: %s{tests.Name} (%i{tests.Tests.Length} tests to run)"
 
-        match tests.SetUp with
+        match tests.OneTimeSetUp with
         | Some su ->
             if not (isNull (su.Invoke (null, [||]))) then
                 failwith "Setup procedure returned non-null"
@@ -194,7 +195,7 @@ module TestFixture =
                 Interlocked.Add (totalTestSuccess, testSuccess.Value) |> ignore<int>
                 eprintfn $"Finished test %s{test.Name} (%i{testSuccess.Value} success)"
         finally
-            match tests.TearDown with
+            match tests.OneTimeTearDown with
             | Some td ->
                 if not (isNull (td.Invoke (null, [||]))) then
                     failwith "TearDown procedure returned non-null"
@@ -208,24 +209,24 @@ module TestFixture =
         ||> Seq.fold (fun state mi ->
             if
                 mi.CustomAttributes
-                |> Seq.exists (fun attr -> attr.AttributeType.FullName = "NUnit.Framework.SetUpAttribute")
+                |> Seq.exists (fun attr -> attr.AttributeType.FullName = "NUnit.Framework.OneTimeSetUpAttribute")
             then
-                match state.SetUp with
+                match state.OneTimeSetUp with
                 | None ->
                     { state with
-                        SetUp = Some mi
+                        OneTimeSetUp = Some mi
                     }
-                | Some _existing -> failwith "Multiple SetUp methods found"
+                | Some _existing -> failwith "Multiple OneTimeSetUp methods found"
             elif
                 mi.CustomAttributes
-                |> Seq.exists (fun attr -> attr.AttributeType.FullName = "NUnit.Framework.TearDownAttribute")
+                |> Seq.exists (fun attr -> attr.AttributeType.FullName = "NUnit.Framework.OneTimeTearDownAttribute")
             then
-                match state.TearDown with
+                match state.OneTimeTearDown with
                 | None ->
                     { state with
-                        TearDown = Some mi
+                        OneTimeTearDown = Some mi
                     }
-                | Some _existing -> failwith "Multiple TearDown methods found"
+                | Some _existing -> failwith "Multiple OneTimeTearDown methods found"
             else
                 match SingleTestMethod.parse mi with
                 | Some test ->
@@ -238,14 +239,16 @@ module TestFixture =
 module Program =
     [<EntryPoint>]
     let main argv =
-        let testDll =
-            match argv with
-            | [| dll |] -> FileInfo dll
+        let testDll, filter =
+            match argv |> List.ofSeq with
+            | [ dll ] -> FileInfo dll, None
+            | [ dll ; "--filter" ; filter ] -> FileInfo dll, Some (FilterIntermediate.parse filter |> Filter.make)
             | _ -> failwith "provide exactly one arg, a test DLL"
 
         let assy = Assembly.LoadFrom testDll.FullName
 
         assy.ExportedTypes
+        // TODO: NUnit nowadays doesn't care if you're a TestFixture or not
         |> Seq.filter (fun ty ->
             ty.CustomAttributes
             |> Seq.exists (fun attr -> attr.AttributeType.FullName = "NUnit.Framework.TestFixtureAttribute")

TestRunner.Test/TestFilter.fs

@@ -0,0 +1,115 @@
+namespace TestRunner.Test
+
+open TestRunner
+open NUnit.Framework
+open FsUnitTyped
+
+[<TestFixture>]
+module TestFilter =
+
+    let docExamples =
+        [
+            "(Name~MyClass) | (Name~MyClass2)",
+            FilterIntermediate.Or (
+                FilterIntermediate.Contains (FilterIntermediate.Name, FilterIntermediate.String "MyClass"),
+                FilterIntermediate.Contains (FilterIntermediate.Name, FilterIntermediate.String "MyClass2")
+            )
+            "xyz", FilterIntermediate.Contains (FilterIntermediate.FullyQualifiedName, FilterIntermediate.String "xyz")
+            "FullyQualifiedName~xyz",
+            FilterIntermediate.Contains (FilterIntermediate.FullyQualifiedName, FilterIntermediate.String "xyz")
+            "FullyQualifiedName!~IntegrationTests",
+            FilterIntermediate.Not (
+                FilterIntermediate.Contains (
+                    FilterIntermediate.FullyQualifiedName,
+                    FilterIntermediate.String "IntegrationTests"
+                )
+            )
+            "FullyQualifiedName=MyNamespace.MyTestsClass<ParameterType1%2CParameterType2>.MyTestMethod",
+            FilterIntermediate.Equal (
+                FilterIntermediate.FullyQualifiedName,
+                FilterIntermediate.String "MyNamespace.MyTestsClass<ParameterType1%2CParameterType2>.MyTestMethod"
+            )
+            "Name~Method", FilterIntermediate.Contains (FilterIntermediate.Name, FilterIntermediate.String "Method")
+            "FullyQualifiedName!=MSTestNamespace.UnitTest1.TestMethod1",
+            FilterIntermediate.Not (
+                FilterIntermediate.Equal (
+                    FilterIntermediate.FullyQualifiedName,
+                    FilterIntermediate.String "MSTestNamespace.UnitTest1.TestMethod1"
+                )
+            )
+            "TestCategory=CategoryA",
+            FilterIntermediate.Equal (FilterIntermediate.TestCategory, FilterIntermediate.String "CategoryA")
+            "FullyQualifiedName~UnitTest1|TestCategory=CategoryA",
+            FilterIntermediate.Or (
+                FilterIntermediate.Contains (
+                    FilterIntermediate.FullyQualifiedName,
+                    FilterIntermediate.String "UnitTest1"
+                ),
+                FilterIntermediate.Equal (FilterIntermediate.TestCategory, FilterIntermediate.String "CategoryA")
+            )
+            "FullyQualifiedName~UnitTest1&TestCategory=CategoryA",
+            FilterIntermediate.And (
+                FilterIntermediate.Contains (
+                    FilterIntermediate.FullyQualifiedName,
+                    FilterIntermediate.String "UnitTest1"
+                ),
+                FilterIntermediate.Equal (FilterIntermediate.TestCategory, FilterIntermediate.String "CategoryA")
+            )
+            "(FullyQualifiedName~UnitTest1&TestCategory=CategoryA)|TestCategory=1",
+            FilterIntermediate.Or (
+                FilterIntermediate.And (
+                    FilterIntermediate.Contains (
+                        FilterIntermediate.FullyQualifiedName,
+                        FilterIntermediate.String "UnitTest1"
+                    ),
+                    FilterIntermediate.Equal (FilterIntermediate.TestCategory, FilterIntermediate.String "CategoryA")
+                ),
+                FilterIntermediate.Equal (FilterIntermediate.TestCategory, FilterIntermediate.String "1")
+            )
+        ]
+        |> List.map TestCaseData
+
+    [<TestCaseSource(nameof docExamples)>]
+    let ``Doc examples`` (example : string, expected : FilterIntermediate) =
+        FilterIntermediate.parse example |> shouldEqual expected
+
+    let docExamplesRefined =
+        [
+            "(Name~MyClass) | (Name~MyClass2)",
+            Filter.Or (Filter.Name (Match.Contains "MyClass"), Filter.Name (Match.Contains "MyClass2"))
+            "xyz", Filter.FullyQualifiedName (Match.Contains "xyz")
+            "FullyQualifiedName~xyz", Filter.FullyQualifiedName (Match.Contains "xyz")
+            "FullyQualifiedName!~IntegrationTests",
+            Filter.Not (Filter.FullyQualifiedName (Match.Contains "IntegrationTests"))
+            "FullyQualifiedName=MyNamespace.MyTestsClass<ParameterType1%2CParameterType2>.MyTestMethod",
+            Filter.FullyQualifiedName (
+                Match.Exact "MyNamespace.MyTestsClass<ParameterType1%2CParameterType2>.MyTestMethod"
+            )
+            "Name~Method", Filter.Name (Match.Contains "Method")
+            "FullyQualifiedName!=MSTestNamespace.UnitTest1.TestMethod1",
+            Filter.Not (Filter.FullyQualifiedName (Match.Exact "MSTestNamespace.UnitTest1.TestMethod1"))
+            "TestCategory=CategoryA", Filter.TestCategory (Match.Exact "CategoryA")
+            "FullyQualifiedName~UnitTest1|TestCategory=CategoryA",
+            Filter.Or (
+                Filter.FullyQualifiedName (Match.Contains "UnitTest1"),
+                Filter.TestCategory (Match.Exact "CategoryA")
+            )
+            "FullyQualifiedName~UnitTest1&TestCategory=CategoryA",
+            Filter.And (
+                Filter.FullyQualifiedName (Match.Contains "UnitTest1"),
+                Filter.TestCategory (Match.Exact "CategoryA")
+            )
+            "(FullyQualifiedName~UnitTest1&TestCategory=CategoryA)|TestCategory=1",
+            Filter.Or (
+                Filter.And (
+                    Filter.FullyQualifiedName (Match.Contains "UnitTest1"),
+                    Filter.TestCategory (Match.Exact "CategoryA")
+                ),
+                Filter.TestCategory (Match.Exact "1")
+            )
+        ]
+        |> List.map TestCaseData
+
+    [<TestCaseSource(nameof docExamplesRefined)>]
+    let ``Doc examples, refined`` (example : string, expected : Filter) =
+        FilterIntermediate.parse example |> Filter.make |> shouldEqual expected

TestRunner.Test/TestRunner.Test.fsproj

@@ -0,0 +1,27 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+    <PropertyGroup>
+        <TargetFramework>net8.0</TargetFramework>
+
+        <IsPackable>false</IsPackable>
+        <IsTestProject>true</IsTestProject>
+    </PropertyGroup>
+
+    <ItemGroup>
+        <Compile Include="TestFilter.fs" />
+    </ItemGroup>
+
+    <ItemGroup>
+        <PackageReference Include="coverlet.collector" Version="6.0.0"/>
+        <PackageReference Include="FsUnit" Version="6.0.0" />
+        <PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.10.0" />
+        <PackageReference Include="NUnit" Version="4.1.0" />
+        <PackageReference Include="NUnit.Analyzers" Version="3.9.0"/>
+        <PackageReference Include="NUnit3TestAdapter" Version="4.5.0"/>
+    </ItemGroup>
+
+    <ItemGroup>
+      <ProjectReference Include="..\TestRunner.fsproj" />
+    </ItemGroup>
+
+</Project>

TestRunner.fsproj

@@ -6,6 +6,7 @@
   </PropertyGroup>
 
   <ItemGroup>
+    <Compile Include="Filter.fs" />
     <Compile Include="Program.fs" />
   </ItemGroup>
 
@@ -13,4 +14,8 @@
     <PackageReference Include="NUnit" Version="4.1.0" />
   </ItemGroup>
 
+  <ItemGroup>
+    <ProjectReference Include="..\PrattParser\PrattParser\PrattParser.fsproj" />
+  </ItemGroup>
+
 </Project>

TestRunner.sln

@@ -0,0 +1,28 @@
+
+Microsoft Visual Studio Solution File, Format Version 12.00
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "TestRunner", "TestRunner.fsproj", "{D4CAE716-79EB-4174-B58C-54E66CF16536}"
+EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "PrattParser", "..\PrattParser\PrattParser\PrattParser.fsproj", "{FD6678F3-9221-414B-8D54-2B2E16ED4B94}"
+EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "TestRunner.Test", "TestRunner.Test\TestRunner.Test.fsproj", "{E776AC80-CD07-4A3E-9F85-1AEFBB56309D}"
+EndProject
+Global
+	GlobalSection(SolutionConfigurationPlatforms) = preSolution
+		Debug|Any CPU = Debug|Any CPU
+		Release|Any CPU = Release|Any CPU
+	EndGlobalSection
+	GlobalSection(ProjectConfigurationPlatforms) = postSolution
+		{D4CAE716-79EB-4174-B58C-54E66CF16536}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{D4CAE716-79EB-4174-B58C-54E66CF16536}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{D4CAE716-79EB-4174-B58C-54E66CF16536}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{D4CAE716-79EB-4174-B58C-54E66CF16536}.Release|Any CPU.Build.0 = Release|Any CPU
+		{FD6678F3-9221-414B-8D54-2B2E16ED4B94}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{FD6678F3-9221-414B-8D54-2B2E16ED4B94}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{FD6678F3-9221-414B-8D54-2B2E16ED4B94}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{FD6678F3-9221-414B-8D54-2B2E16ED4B94}.Release|Any CPU.Build.0 = Release|Any CPU
+		{E776AC80-CD07-4A3E-9F85-1AEFBB56309D}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{E776AC80-CD07-4A3E-9F85-1AEFBB56309D}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{E776AC80-CD07-4A3E-9F85-1AEFBB56309D}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{E776AC80-CD07-4A3E-9F85-1AEFBB56309D}.Release|Any CPU.Build.0 = Release|Any CPU
+	EndGlobalSection
+EndGlobal