parser-c 0.3.0

Macros for parser-c.
Documentation 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

module Main where

import Data.List (intercalate)
import System.Exit (ExitCode(..), exitFailure, exitSuccess, exitWith)
import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory, setCurrentDirectory,
                         getDirectoryContents)
import System.FilePath ((</>))
import System.Process (readProcessWithExitCode, callProcess)
import System.IO (hPutStrLn, hPrint, stderr)
import Control.Monad (filterM, liftM, when)

testDirs :: [String]
testDirs = ["test/harness","harness","."]

getActualTestDirectory :: [String] -> IO FilePath
getActualTestDirectory test_dirs = do
  validDirs <- filterM (doesFileExist . (</> "run-harness.hs")) test_dirs
  case validDirs of
    []    -> ioError (userError ("run-harness.hs not found in " ++ intercalate " or " test_dirs))
    (d:_) -> return d

subdirectoriesOf :: FilePath -> IO [FilePath]
subdirectoriesOf fp = do
  entries <- getDirectoryContents fp
  filterM (doesDirectoryExist . (fp </>)) (filter (not . isSpecialDir) entries)
  where
    isSpecialDir "." = True
    isSpecialDir ".." = True
    isSpecialDir _ = False

-- from Control.Monad.Extra
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
findM _ [] = return Nothing
findM p (x:xs) = do guard <- p x ; if guard then (return $ Just x) else (findM p xs)

main :: IO ExitCode
main = do
  actual_test_dir <- getActualTestDirectory testDirs
  has_makefile <- doesFileExist (actual_test_dir </> "Makefile")
  when (not has_makefile) $ do
    hPutStrLn stderr "No Makefile found (out of source tree)"
    hPutStrLn stderr "Skipping harness test"
    exitWith ExitSuccess
  tests <- subdirectoriesOf actual_test_dir
  cdir <- getCurrentDirectory
  hPutStrLn stderr ("Changing to test directory " ++ actual_test_dir ++ " and compiling")
  -- build test executables
  setCurrentDirectory (cdir</>actual_test_dir)
  callProcess "make" ["prepare"]
  -- run harness tests
  hasFailure <- findM (liftM (/= ExitSuccess) . runTest . (cdir</>) . (actual_test_dir</>)) tests
  setCurrentDirectory cdir
  case hasFailure of
    Nothing -> exitSuccess
    Just _failed -> exitFailure
  where
    runTest :: FilePath -> IO ExitCode
    runTest dir = do
      setCurrentDirectory dir
      (exitCode, _outp, _errp) <- readProcessWithExitCode "make" [] ""
      hPutStrLn stderr ("cd " ++ dir ++ " && make: " ++ show exitCode)
      when (exitCode /= ExitSuccess) $ do
        hPutStrLn stderr "=== Standard Output ==="
        hPutStrLn stderr _outp
        hPutStrLn stderr "=== Error Output ==="
        hPutStrLn stderr _errp
        hPutStrLn stderr "=== End of Output ==="
      return exitCode