forked from GitHub/gf-core
38 lines
2.2 KiB
Haskell
38 lines
2.2 KiB
Haskell
import Control.Exception
|
|
import Test.HUnit
|
|
import PGF2
|
|
|
|
main = do
|
|
x <- testLoadFailure "non-existing.pgf"
|
|
x <- testLoadFailure "tests/basic.gf"
|
|
gr <- readPGF "tests/basic.pgf"
|
|
runTestTTAndExit $
|
|
TestList [TestCase (assertBool "loading failure handled" x)
|
|
,TestCase (assertEqual "abstract names" "basic" (abstractName gr))
|
|
,TestCase (assertEqual "abstract categories" ["Float","Int","N","P","S","String"] (categories gr))
|
|
,TestCase (assertEqual "abstract functions" ["c","ind","s","z"] (functions gr))
|
|
,TestCase (assertEqual "abstract functions by cat 1" ["s","z"] (functionsByCat gr "N"))
|
|
,TestCase (assertEqual "abstract functions by cat 2" ["c"] (functionsByCat gr "S"))
|
|
,TestCase (assertEqual "abstract functions by cat 2" [] (functionsByCat gr "X")) -- no such category
|
|
,TestCase (assertBool "type of z" (eqJust (readType "N") (functionType gr "z")))
|
|
,TestCase (assertBool "type of s" (eqJust (readType "N->N") (functionType gr "s")))
|
|
,TestCase (assertBool "type of c" (eqJust (readType "N->S") (functionType gr "c")))
|
|
,TestCase (assertEqual "category context 1" [] (categoryContext gr "N"))
|
|
,TestCase (assertEqual "category context 1" [] (categoryContext gr "S"))
|
|
,TestCase (assertEqual "category context 1" [(Explicit,"_",DTyp [] "N" [])] (categoryContext gr "P"))
|
|
,TestCase (assertEqual "category context 1" [] (categoryContext gr "X")) -- no such category
|
|
,TestCase (assertEqual "function is constructor 1" True (functionIsConstructor gr "s"))
|
|
,TestCase (assertEqual "function is constructor 2" True (functionIsConstructor gr "z"))
|
|
,TestCase (assertEqual "function is constructor 3" True (functionIsConstructor gr "c"))
|
|
,TestCase (assertEqual "function is constructor 4" False (functionIsConstructor gr "ind"))
|
|
]
|
|
|
|
testLoadFailure fpath = do
|
|
res <- try (readPGF fpath)
|
|
case res :: Either SomeException PGF of
|
|
Left _ -> return True
|
|
Right _ -> return False
|
|
|
|
eqJust (Just x) (Just y) = x == y
|
|
eqJust _ _ = False
|