unit-testing - 从文件系统动态生成 Tasty `TestTree`

Question

我使用 Parsec 编写了一个文件解析器图书馆。我想使用 Tasty 编写高级单元测试测试框架以确保解析器正确解析某些给定文件。

我在以下目录结构中有三个格式正确的文件:

path/to/files -+
               |-> fileA
               |-> fileB
               |-> fileC

我想:

获取 path/to/files 中的所有文件

读取每个文件的内容

创建 testCase 确保文件内容被成功解析的每个文件

让它动态完成，这样我以后可以添加更多文件，并且永远不会更改代码

我设法构建了以下内容:

{-# LANGUAGE BangPatterns, FlexibleContexts #-}

module Test.MyParser
  ( testSuite
  ) where

import Control.Arrow              ((&&&))
import Data.Map                   (Map,fromList,toList)
import System.Directory
import System.IO.Unsafe           (unsafePerformIO) -- This is used for a hack
import Test.Tasty                 (TestTree,testGroup,withResource)
import Test.Tasty.HUnit
import Text.Parsec

-- | Determine if an Either is a Right or Left value
--   Useful for determining if a parse attempt was successful
isLeft, isRight :: Either a b  -> Bool
isLeft (Left _) = True
isLeft _        = False
isRight = not . isLeft

-- | My file parser, a Parsec monad definition
myFileParser :: Parsec s u a
myFileParser = undefined -- The parser's definition is irrelivant

-- | Gets all the given files and thier contents in the specified directory
getFileContentsInDirectory :: FilePath -> IO (Map FilePath String)
getFileContentsInDirectory path = do
    files <- filter isFile <$> getDirectoryContents path
    sequence . fromList $ (id &&& readFile) . withPath <$> files
  where
    isFile = not . all (=='.')
    withPath file = if last path /= '/'
                    then concat [path,"/",file]
                    else concat [path,    file]

-- | Reads in all files in a directory and ensures that they correctly parse
--   NOTE: Library hack :(
--   On success, no file names will be displayed.
--   On the first failure, no subsequent files will have parsing attempt tried
--   and the file path for the failed file will be displayed.

testSuite :: TestTree
testSuite = testGroup "Files that should successfully be parsed" [withResource validContents release validateFiles]
  where
    validContents = getFileContentsInDirectory "path/to/files"
    release = const $ pure ()
    parse'  :: (FilePath,String) -> Either ParseError a
    parse'  (path,content) = parse myFileParser path content
    success :: (FilePath,String) -> Assertion
    success (path,content) = assertBool path . isRight $ parse' (path,content)
    validateFiles :: IO (Map FilePath String) -> TestTree
    validateFiles !filesIO = testGroup "Valid files" [testCase "Unexpected parse errors" fileTree]
      where
        fileTree :: IO () --also an Assertion
        fileTree = do
          files <- toList <$> filesIO
          sequence_ $ success <$> files

这种结构有效，但并不理想。这是因为 testSuite 时生成的输出is run 不是很具有描述性。

成功时:

Files that should successfully be parsed
  Valid files
    Unexpected parse errors: OK (6.54s)

失败时:

Files that should successfully be parsed
  Valid files
    Unexpected parse errors: FAIL (3.40s)
      path/to/files/fileB

这个输出并不理想，因为它只会输出第一个解析失败的文件，而不是所有失败的文件。此外，无论是否有任何失败，它也不会告诉您哪些文件被成功解析。

我希望测试树看起来像这样:

成功时:

Files that should successfully be parsed
  Valid files
    "path/to/files/fileA": OK (2.34s)
    "path/to/files/fileB": OK (3.45s)
    "path/to/files/fileC": OK (4.56s)

失败时:

Files that should successfully be parsed
  Valid files
    "path/to/files/fileA": OK   (2.34s)
    "path/to/files/fileB": FAIL (3.45s)
    "path/to/files/fileC": FAIL (4.56s)

这是我尝试制作一个格式良好的 TestTree 从文件系统动态:

-- | How I would like the code to work, except for the `unsafePerformIO` call
testSuite' :: TestTree
testSuite' = testGroup "Files that should successfully be parsed" [withResource validContents release validateFiles]
  where
    validContents = getFileContentsInDirectory "path/to/files"
    release = const $ pure ()
    parse'  :: (FilePath,String) -> Either ParseError a
    parse'  (path,content) = parse myFileParser path content
    success :: (FilePath,String) -> TestTree
    success (path,content) = testCase (show path) . assert . isRight $ parse' (path,content)
    validateFiles :: IO (Map FilePath String) -> TestTree
    validateFiles !filesIO = testGroup "Valid files" $ unsafePerformIO fileTree
      where
        fileTree :: IO [TestTree]
        fileTree = fmap success . toList <$> filesIO

可以看到，有一个难看的 unsafePerformIO 调用此代码以提取 TestTree 通过 unsafePerformIO :: IO [TestTree] -> [TestTree] .我觉得不得不使用这个不安全的函数调用，因为我不知道如何使用从 testCase 中的文件系统(文件名)派生的信息。建筑。结果 [TestTree] was trapped在 IO 单子(monad)。

使用这个不安全的函数不仅不理想，而且它甚至不起作用，因为 IO 行动实际上是不安全的。测试套件永远不会运行，因为引发了以下异常:

*** Exception: Unhandled resource. Probably a bug in the runner you're using.

给定 withResource 的类型签名:

withResource :: IO a               -- initialize the resource
             -> (a -> IO ())       -- free the resource
             -> (IO a -> TestTree) -- IO a is an action which returns the acquired resource. Despite it being an IO action, the resource it returns will be acquired only once and shared across all the tests in the tree.
             -> TestTree

我发现不可能构造 IO a -> TestTree 类型的函数对于 withResource 的最后一个参数不使用 IO a输入 TestName testCase 的参数或 testGroup 来电。尽管审查了 Tasty 框架作者 verbose explanation ，也许我想念如何 withResources 应该是使用的。或许 Tasty 框架内有更好的功能来实现想要的 TestTree ?

问题:

如何动态创建 TestTree 来自具有所需描述性输出的文件系统？

Answer 1

您不能通过资源动态构造 TestTree 的事实是非常有意的。当我写 here ,

One of the major problems with tests receiving the resource value directly, as in

withResource
  :: IO a
  -> (a -> IO ())
  -> (a -> TestTree)
  -> TestTree

... was that the resource could be used not only in the tests themselves, but to construct the tests, which is bad/wrong for a number of reasons. For instance, we don't want to create the resources when we're not running tests, but we still want to know which tests we have.

所以资源不应该被用来构建测试树；它们是为不同的用例设计的。

那么，如何动态构建测试树呢？诀窍是要意识到你的 main可以不仅仅是 defaultMain .确实，它可以利用IO的全部威力来构造一个测试树，然后调用 defaultMain使用动态构建的测试树。

所以，

main = do
  testTree <- constructTestTree
  defaultMain testTree

你可以在 haskell-src-ext's testsuite 中看到一个真实的例子。 .