run.hs

import Control.Monad ( unless, forM, liftM )
import System.Exit ( ExitCode(..) )
import Data.Maybe ( isNothing, fromJust )
import System.Directory (doesDirectoryExist, getDirectoryContents, doesFileExist)
import System.FilePath ((</>), takeExtension, replaceExtension)

import Test.Framework
import Test.Framework.TestManager ( makeBlackBoxTest )
import Test.Framework.TestTypes ( Test )
import Test.Framework.BlackBoxTest ( defaultDiff )
import Test.HUnit ( assertFailure )

import System.Process ( readProcessWithExitCode )

runTest :: FilePath -- ^ name of program under test
        -> [String] -- ^ cli arguments
        -> FilePath -- ^ stdin
        -> Maybe FilePath -- ^ stdout
        -> Maybe FilePath -- ^ stderr
        -> Test
runTest put args inF outF errF = makeBlackBoxTest testID assertion
  where testID = inF
        assertion =
          do stdin <- readFile inF
             (s,out,err) <- readProcessWithExitCode put args stdin
             unless ( s == ExitSuccess ) $ assertFailure ( "Exit code: " ++ show s )
             outDiff <- defaultDiff outF out
             assertNoDiff outF out
             assertNoDiff errF err
        assertNoDiff file str =
          defaultDiff file str >>= \d -> 
            unless ( isNothing d ) ( assertFailure ( fromJust d ) )

findFiles :: FilePath -- ^ root dir
          -> IO [FilePath]
findFiles root = do
  names <- getDirectoryContents root
  let properNames = filter (`notElem` [".", ".."]) names
  paths <- forM properNames $ \name -> do
    let path = root </> name
    isDirectory <- doesDirectoryExist path
    if isDirectory
      then findFiles path
      else return [path]
  return (concat paths)

findGfsFiles = liftM ( filter ( hasExtension ".gfs" ) ) . findFiles
  where hasExtension ext = (== ext) . takeExtension

runGfsTest :: FilePath -> IO Test
runGfsTest file = do
    outF <- maybeFile ( replaceExtension file ".out" )
    errF <- maybeFile ( replaceExtension file ".err" )
    return $ runTest  "dist/build/gf/gf" ["--run"] file outF errF
  where maybeFile f = do b <- doesFileExist f
                         return ( if b then Just f else Nothing )

main =
  findGfsFiles "lib/tests" >>= mapM runGfsTest >>= htfMain