61 lines
1.9 KiB
Haskell
61 lines
1.9 KiB
Haskell
--- SJW -- Clean Javascript modules for front-end development
|
|
--- Copyright © 2022 Tissevert <tissevert+devel@marvid.fr>
|
|
---
|
|
--- This file is part of SJW.
|
|
---
|
|
--- SJW is free software: you can redistribute it and/or modify it under the
|
|
--- terms of the GNU General Public License as published by the Free Software
|
|
--- Foundation, either version 3 of the License, or (at your option) any later
|
|
--- version.
|
|
---
|
|
--- SJW is distributed in the hope that it will be useful, but WITHOUT ANY
|
|
--- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
|
|
--- FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
|
|
--- details.
|
|
---
|
|
--- You should have received a copy of the GNU General Public License along
|
|
--- with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
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)
|
|
]
|