Revision f94b06de7edcb61d3c49f19417e53dc7dc21d552 authored by Anish Tondwalkar on 22 June 2021, 08:13:54 UTC, committed by Anish Tondwalkar on 22 June 2021, 08:13:54 UTC
1 parent 0a9345e
Tests.hs
module Tests.Integration.Tests (integrationTests) where
import Control.Exception
import Control.Monad
import Data.Bool (bool)
import System.Directory
import System.Exit
import System.FilePath
import System.IO.Error
import System.IO
import Text.Printf
import Test.Tasty
import Test.Tasty.HUnit
import Tests.Utils
import Language.Mist.Runner
import Language.Mist.Config
import Language.Mist.UX (Result, SourceSpan, UserError)
import System.Console.CmdArgs.Verbosity
integrationTests = testGroupM "Integration"
[ testGroup "pos" <$> dirTests "tests/Tests/Integration/pos" (mkTest mistSuccess)
, testGroup "neg" <$> dirTests "tests/Tests/Integration/neg" (mkTest mistFailure)
, testGroup "todo" <$> dirTests "tests/Tests/Integration/todo" crashTest
]
---------------------------------------------------------------------------
dirTests :: FilePath -> (FilePath -> TestName -> TestTree) -> IO [TestTree]
---------------------------------------------------------------------------
dirTests root testPred = do
files <- walkDirectory root
let tests = [ rel | f <- files, isTest f, let rel = makeRelative root f ]
return $ testPred root <$> tests
isTest :: FilePath -> Bool
isTest f = takeExtension f `elem` [".hs"]
---------------------------------------------------------------------------
mkTest :: (Result () -> IO ()) -> FilePath -> TestName -> TestTree
---------------------------------------------------------------------------
mkTest testPred dir file = testCase file $ do
createDirectoryIfMissing True $ takeDirectory log
withFile log WriteMode $ \h -> do
setVerbosity Quiet
ec <- runMist h (defConfig {srcFile = test})
testPred ec
where
test = dir </> file
log = let (d, f) = splitFileName file in dir </> d </> ".liquid" </> f <.> "log"
data MistException = Success | Failure [UserError]
deriving Show
instance Exception MistException
-- TODO abstract logging machinery, make tests fail when they don't crash
crashTest :: FilePath -> TestName -> TestTree
crashTest dir file = testCase file $ do
createDirectoryIfMissing True $ takeDirectory log
withFile log WriteMode $ \h -> (do
ec <- (runMist h (defConfig {srcFile = test})) `catch` (\(SomeException _) -> pure $ Left [])
case ec of
Right _ -> throw Success
Left errors -> throw $ Failure errors) `catch` handler
where
test = dir </> file
log = let (d, f) = splitFileName file in dir </> d </> ".liquid" </> f <.> "log"
handler Success = assertFailure "expected failure but Mist succeeded"
handler (Failure _) = pure ()
mistSuccess :: Result a -> Assertion
mistSuccess (Right _) = pure ()
mistSuccess (Left errors) = assertFailure (printf "expected success but got errors: %s" (show errors))
mistFailure :: Result a -> Assertion
mistFailure (Right _) = assertFailure "expected failure but Mist succeeded"
mistFailure (Left _) = pure ()
---------------------------------------------------------------------------
walkDirectory :: FilePath -> IO [FilePath]
---------------------------------------------------------------------------
walkDirectory root =
fmap concat . traverse collect . candidates
=<< (getDirectoryContents root `catchIOError` const (return []))
where
candidates fs = [root </> f | f <- fs, not (isExtSeparator (head f))]
collect f = liftM3 bool (pure [f]) (walkDirectory f) (doesDirectoryExist f)
Computing file changes ...