如何在Haskell Tasty测试中捕获stdout并模拟stdin？

问题概述 #

需要测试HangmanImpure模块中的getLine和putStr函数：验证getLine返回输入内容、putStr将参数输出到stdout。尝试用SmallCheck编写属性测试时不知如何填充逻辑，后续用HUnit测试出现失败，需完善测试并解决失败问题。

自定义不纯函数代码 #

module HangmanImpure (HangmanImpure.getLine, HangmanImpure.putStr, HangmanImpure.putStrLn, HangmanImpure.strlen) where

import qualified System.IO as Sys

getLine :: IO String
getLine = do x <- Sys.getChar
             if x == '\n' then
                 return []
             else
                do xs <- HangmanImpure.getLine
                   return (x:xs)

putStr :: String -> IO ()
putStr [] = return ()
putStr (x:xs) = do Sys.putChar x
                   HangmanImpure.putStr xs

问题分析 #

1. SmallCheck测试障碍：SmallCheck默认测试纯函数，直接测试IO动作需要将其转换为可验证的纯属性，必须借助模拟/捕获stdin/stdout的工具隔离IO操作。
2. HUnit测试失败原因：
   • 自定义getLine会丢弃输入末尾的\n，返回不含换行的字符串。
   • 原测试通过echo函数间接验证，而Prelude.putStrLn会额外添加换行，导致捕获的stdout与输入不匹配。
   • 间接测试不如直接验证getLine返回值和putStr输出准确。

解决方案 #

1. 基础工具函数实现 #

先实现模拟stdin和捕获stdout的工具函数，用于隔离IO操作：

module StdInStdOutUtil (provideStdin, captureStdout) where

import System.IO (hDuplicate, hDuplicateTo, stdin, stdout, withFile, IOMode(ReadMode, WriteMode))
import System.Directory (createTempDirectory, getTemporaryDirectory, removeFile)
import Control.Exception (bracket)

-- 为IO动作提供模拟的stdin输入
provideStdin :: String -> IO a -> IO a
provideStdin input action = bracket createTmpFile removeFile $ \filePath -> do
  writeFile filePath input
  withFile filePath ReadMode $ \h -> do
    oldStdin <- hDuplicate stdin
    hDuplicateTo h stdin
    result <- action
    hDuplicateTo oldStdin stdin
    return result
  where
    createTmpFile = do
      tmpDir <- getTemporaryDirectory
      tmpDir' <- createTempDirectory tmpDir "test-stdin"
      return $ tmpDir' ++ "/input.txt"

-- 捕获IO动作的stdout输出
captureStdout :: IO () -> IO String
captureStdout action = bracket createTmpFile removeFile $ \filePath -> do
  withFile filePath WriteMode $ \h -> do
    oldStdout <- hDuplicate stdout
    hDuplicateTo h stdout
    action
    hDuplicateTo oldStdout stdout
  readFile filePath
  where
    createTmpFile = do
      tmpDir <- getTemporaryDirectory
      tmpDir' <- createTempDirectory tmpDir "test-stdout"
      return $ tmpDir' ++ "/output.txt"

2. HUnit测试修复 #

直接测试getLine返回值和putStr输出：

module TestHangmanImpure (properties) where
    
import qualified Test.Tasty as T
import qualified Test.Tasty.HUnit as HU
    
import StdInStdOutUtil as IOU (captureStdout, provideStdin)
import HangmanImpure as HI (getLine, putStr)
    
properties :: T.TestTree
properties = T.testGroup "HangmanImpure Tests" [uTests]
    
uTests :: T.TestTree
uTests = T.testGroup "HUnit Tests"
        [
            HU.testCase "getLine returns input without trailing newline" $ do
                let input = "Hello, Hangman!"
                result <- IOU.provideStdin (input ++ "\n") HI.getLine
                HU.assertEqual "getLine return value mismatch" input result

            , HU.testCase "putStr writes exact input to stdout" $ do
                let testStr = "Testing putStr function!"
                output <- IOU.captureStdout (HI.putStr testStr)
                HU.assertEqual "putStr output mismatch" testStr output
        ]

3. SmallCheck属性测试 #

使用smallcheck-io包（先安装：cabal install smallcheck-io），将IO动作转换为可测试的属性：

module TestHangmanImpure (scProps) where

import qualified Test.Tasty as T
import qualified Test.Tasty.SmallCheck as SC
import qualified Test.Tasty.SmallCheck.IO as SCIO

import StdInStdOutUtil as IOU (captureStdout, provideStdin)
import HangmanImpure as HI (getLine, putStr)

scProps :: T.TestTree
scProps = T.testGroup "SmallCheck Properties"
    [
        SC.testProperty "getLine returns all input except trailing newline" $ \s ->
            SCIO.ioProperty $ do
                result <- IOU.provideStdin (s ++ "\n") HI.getLine
                return $ result == s

        , SC.testProperty "putStr writes entire input to stdout" $ \s ->
            SCIO.ioProperty $ do
                output <- IOU.captureStdout (HI.putStr s)
                return $ output == s
    ]

4. 整合所有测试 #

将HUnit和SmallCheck测试整合到一个测试套件：

module Main where

import qualified Test.Tasty as T
import TestHangmanImpure (properties, scProps)

main :: IO ()
main = T.defaultMain $ T.testGroup "All HangmanImpure Tests"
    [ properties
    , scProps
    ]

测试说明 #

• getLine测试：模拟输入字符串加换行符，验证返回值为不含换行的原字符串。
• putStr测试：捕获输出，验证与输入字符串完全一致。
• SmallCheck会自动生成多个小字符串作为测试用例，覆盖空字符串、短字符串、含特殊字符的字符串等场景。

内容的提问来源于stack exchange，提问作者Øyvind Roth