Merge pull request #10427 from 9999years/cabal-testsuite-pattern-arg

Make `cabal-testsuite` filterable with `--pattern`

Author: mergify[bot]

cabal-testsuite/README.md

@@ -1,18 +1,21 @@
 cabal-testsuite is a suite of integration tests for Cabal-based
 frameworks.
 
-How to run
-----------
+# How to run
 
 1. Build `cabal-testsuite` (`cabal build cabal-testsuite:cabal-tests`)
 2. Run the `cabal-tests` executable. It will scan for all tests
    in your current directory and subdirectories and run them.
-   To run a specific set of tests, use `cabal-tests --with-cabal=CABALBIN PATH ...`.
-   (e.g. `cabal run cabal-testsuite:cabal-tests -- --with-cabal=cabal cabal-testsuite/PackageTests/TestOptions/setup.test.hs`)
-   You can control parallelism using the `-j` flag.
 
 There are a few useful flags:
 
+* To run a specific set of tests, pass the path to a `.test.hs` file to run or
+  use the `-p`/`--pattern` flag to filter tests.
+
+  See the ["Selecting tests"](#selecting-tests) section below for more details.
+
+* `-j INT` controls the number of threads used for running tests.
+
 * `--with-cabal PATH` can be used to specify the path of a
   `cabal-install` executable.  IF YOU DO NOT SPECIFY THIS FLAG,
   CABAL INSTALL TESTS WILL NOT RUN.
@@ -28,6 +31,28 @@ There are a few useful flags:
 * `--keep-tmp-files` can be used to keep the temporary directories that tests
   are run in.
 
+## Selecting tests
+
+To run a specific set of tests, use `cabal-tests --with-cabal=CABALBIN PATH ...`, e.g.:
+
+```
+cabal run cabal-testsuite:cabal-tests -- \
+   --with-cabal=cabal \
+   cabal-testsuite/PackageTests/TestOptions/setup.test.hs
+```
+
+Alternatively, use `-p`/`--pattern` to select tests dynamically:
+
+```
+cabal run cabal-testsuite:cabal-tests -- \
+   --with-cabal=cabal \
+   --pattern "/TestOptions/"
+```
+
+See [the documentation for Tasty pattern
+syntax](https://hackage.haskell.org/package/tasty#patterns) for more
+information.
+
 ## Which Cabal library version do cabal-install tests use?
 
 By default the `cabal-install` tests will use the `Cabal` library which comes with
@@ -74,8 +99,7 @@ components have broken doctests
 our CI currently checks that `Cabal-syntax` and `Cabal` doctests pass via
 `make doctest-install && make doctest` (you can use this `make`-based workflow too).
 
-How to write
-------------
+# How to write
 
 If you learn better by example, just look at the tests that live
 in `cabal-testsuite/PackageTests`; if you `git log -p`, you can
@@ -155,8 +179,7 @@ allow multiple tests to be defined in one file but run in parallel;
 at the moment, these just indicate long running tests that should
 be run early (to avoid straggling).
 
-Frequently asked questions
---------------------------
+# Frequently asked questions
 
 For all of these answers, to see examples of the functions in
 question, grep the test suite.
@@ -223,8 +246,7 @@ long before editing a file, in order for file system timestamp
 resolution to pick it up.  Use `withDelay` and `delay` prior to
 making a modification.
 
-Hermetic tests
---------------
+# Hermetic tests
 
 Tests are run in a fresh temporary system directory. This attempts to isolate the
 tests from anything specific to do with your directory structure. In particular
@@ -235,8 +257,7 @@ tests from anything specific to do with your directory structure. In particular
 * You must `git add` all files which are relevant to the test, otherwise
   they will not be copied.
 
-Design notes
-------------
+# Design notes
 
 This is the second rewrite of the integration testing framework.  The
 primary goal was to use Haskell as the test language (letting us take
@@ -296,8 +317,7 @@ figure out how to get out the threading setting, and then spawn
 that many GHCi servers to service the running threads.  Improvements
 welcome.
 
-Expect tests
-------------
+# Expect tests
 
 An expect test (aka _golden test_)
 is a test where we read out the output of the test
@@ -366,8 +386,7 @@ Some other notes:
   on the output for the string you're looking for.  Try to be
   deterministic, but sometimes it's not (easily) possible.
 
-Non-goals
----------
+# Non-goals
 
 Here are some things we do not currently plan on supporting:
 

cabal-testsuite/cabal-testsuite.cabal

@@ -105,6 +105,8 @@ executable cabal-tests
     -- dependencies specific to exe:cabal-tests
     , clock                 ^>= 0.7.2 || ^>=0.8
     , directory
+    , tasty
+    , containers
 
   build-tool-depends: cabal-testsuite:setup
   default-extensions: TypeOperators

cabal-testsuite/main/cabal-tests.hs

@@ -23,7 +23,19 @@ import Control.Exception
 import Control.Monad
 import GHC.Conc (numCapabilities)
 import Data.List
+import Data.Proxy (Proxy(Proxy))
+import qualified Data.Sequence as Seq (fromList)
 import Text.Printf
+import qualified Test.Tasty.Options as Tasty
+  ( OptionSet
+  , OptionDescription (Option)
+  , lookupOption
+  )
+import qualified Test.Tasty.Runners as Tasty
+  ( optionParser
+  , TestPattern
+  , testPatternMatches
+  )
 import qualified System.Clock as Clock
 import System.IO
 import System.FilePath
@@ -72,7 +84,8 @@ data MainArgs = MainArgs {
         mainArgQuiet   :: Bool,
         mainArgDistDir :: Maybe FilePath,
         mainArgCabalSpec :: Maybe CabalLibSpec,
-        mainCommonArgs :: CommonArgs
+        mainCommonArgs :: CommonArgs,
+        mainTastyArgs :: Tasty.OptionSet
     }
 
 data CabalLibSpec = BootCabalLib | InTreeCabalLib FilePath FilePath | SpecificCabalLib String FilePath
@@ -117,6 +130,17 @@ mainArgParser = MainArgs
        <> metavar "DIR"))
     <*> optional cabalLibSpecParser
     <*> commonArgParser
+    <*> tastyArgParser
+
+tastyArgParser :: Parser Tasty.OptionSet
+tastyArgParser =
+  let (warnings, parser) =
+        Tasty.optionParser
+          [ Tasty.Option (Proxy @Tasty.TestPattern)
+          ]
+   in if null warnings
+         then parser
+         else error $ unlines ("Failed to create parser for Tasty CLI options:" : warnings)
 
 -- Unpack and build a specific released version of Cabal and Cabal-syntax libraries
 buildCabalLibsProject :: String -> Verbosity -> Maybe FilePath -> FilePath -> IO [FilePath]
@@ -184,6 +208,7 @@ main = do
     -- Parse arguments.  N.B. 'helper' adds the option `--help`.
     args <- execParser $ info (mainArgParser <**> helper) mempty
     let verbosity = if mainArgVerbose args then verbose else normal
+        testPattern = Tasty.lookupOption @Tasty.TestPattern (mainTastyArgs args)
 
     pkg_dbs <-
       -- Not path to cabal-install so we're not going to run cabal-install tests so we
@@ -264,7 +289,7 @@ main = do
             -- NB: getDirectoryContentsRecursive is lazy IO, but it
             -- doesn't handle directories disappearing gracefully. Fix
             -- this!
-            (single_tests, multi_tests) <- evaluate (partitionTests test_scripts)
+            (single_tests, multi_tests) <- evaluate (partitionTests testPattern test_scripts)
             let all_tests = multi_tests ++ single_tests
                 margin = maximum (map length all_tests) + 2
             hPutStrLn stderr $ "tests to run: " ++ show (length all_tests)
@@ -381,10 +406,19 @@ main = do
 findTests :: IO [FilePath]
 findTests = getDirectoryContentsRecursive "."
 
-partitionTests :: [FilePath] -> ([FilePath], [FilePath])
-partitionTests = go [] []
+-- | Partition a list of paths into a tuple of test paths and multi-test paths.
+--
+-- Non-test paths and test paths that don't match the given `Tasty.TestPattern` are dropped.
+partitionTests :: Tasty.TestPattern -> [FilePath] -> ([FilePath], [FilePath])
+partitionTests testPattern paths =
+  go [] [] paths
   where
-    go ts ms [] = (ts, ms)
+    -- Filter a list, keeping only paths that match the @pattern@.
+    keepPatternMatches = filter (Tasty.testPatternMatches testPattern . toTastyPath)
+
+    toTastyPath path = Seq.fromList $ splitDirectories path
+
+    go ts ms [] = (keepPatternMatches ts, keepPatternMatches ms)
     go ts ms (f:fs) =
         -- NB: Keep this synchronized with isTestFile
         case takeExtensions f of