Implement proper Cabal tests out of the existing structure
This commit is contained in:
parent
2f933aec20
commit
22d910c9c4
23 changed files with 55 additions and 0 deletions
13
SJW.cabal
13
SJW.cabal
|
@ -60,3 +60,16 @@ benchmark big-src
|
|||
, time
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
||||
test-suite tests
|
||||
type: detailed-0.9
|
||||
test-module: Tests
|
||||
build-depends: base >=4.11 && <4.13
|
||||
, Cabal
|
||||
, directory
|
||||
, filepath
|
||||
, random
|
||||
, SJW
|
||||
hs-source-dirs: test
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
|
42
test/Tests.hs
Normal file
42
test/Tests.hs
Normal file
|
@ -0,0 +1,42 @@
|
|||
module Tests (
|
||||
tests
|
||||
) where
|
||||
|
||||
import Distribution.TestSuite
|
||||
import SJW (compile, source)
|
||||
import System.FilePath ((</>))
|
||||
import Text.Printf (printf)
|
||||
|
||||
testData :: FilePath
|
||||
testData = "test" </> "data"
|
||||
|
||||
checkResult :: (String, Bool) -> IO Progress
|
||||
checkResult (dirName, expected) = do
|
||||
result <- either failed passed =<< compile (source [testData </> dirName])
|
||||
return . Finished $ if result == expected then Pass else Fail (explain message)
|
||||
where
|
||||
failed s = putStrLn s>> return False
|
||||
passed _ = return True
|
||||
explain = uncurry (printf "Compilation %sed when it was expected to %s")
|
||||
message = if expected then ("fail", "succeed") else ("succeed", "fail")
|
||||
|
||||
makeTest :: (String, Bool) -> TestInstance
|
||||
makeTest (patternName, expected) = testInstance
|
||||
where
|
||||
testInstance = TestInstance {
|
||||
run = checkResult (patternName, expected)
|
||||
, name = patternName
|
||||
, tags = []
|
||||
, options = []
|
||||
, setOption = \_ _ -> Right testInstance
|
||||
}
|
||||
|
||||
tests :: IO [Test]
|
||||
tests = return $ (Test . makeTest) <$> [
|
||||
("cycle", False)
|
||||
, ("diamond", True)
|
||||
, ("loop", False)
|
||||
, ("q", False)
|
||||
, ("simple", True)
|
||||
, ("triangle", True)
|
||||
]
|
Loading…
Reference in a new issue