git.iko.soy/project-m36
on 97d73bb help sign in
project-m36/test/TutorialD/Interpreter/AtomFunctionScript.hs
55 lines 2.7 kB history raw
1import TutorialD.Interpreter.TestBase
2import System.Exit
3import Test.HUnit
4import ProjectM36.Client
5import ProjectM36.Relation
6import ProjectM36.Base
7import ProjectM36.Error
8import qualified Data.Vector as V
9import qualified Data.Map as M
11main :: IO ()
12main = do
13 tcounts <- runTestTT (TestList [testBasicAtomFunction,
14 testErrorAtomFunction,
15 testNoArgumentAtomFunction
16 ])
17 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
19--add an atom function and run it
20testBasicAtomFunction :: Test
21testBasicAtomFunction = TestCase $ do
22 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
23 executeTutorialD sess conn "addatomfunction \"mkTest\" Int -> Int \"\\\\(IntAtom x:xs) -> IntAtom x\""
24 let attrs = [Attribute "x" IntAtomType]
25 funcAtomExpr = FunctionAtomExpr "mkTest" [NakedAtomExpr (IntAtom 3)] ()
26 tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]
27 expectedResult = mkRelationFromList (V.fromList attrs) [[IntAtom 3]]
28 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)
30 assertEqual "simple atom function equality" expectedResult result
32--add an atom function which bombs out
33testErrorAtomFunction :: Test
34testErrorAtomFunction = TestCase $ do
35 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
36 executeTutorialD sess conn "addatomfunction \"mkTest\" Int -> Int \"\"\"\\(IntAtom x:xs) -> (error (show 1) ) :: Atom\"\"\""
37 let attrs = [Attribute "x" IntAtomType]
38 funcAtomExpr = FunctionAtomExpr "mkTest" [NakedAtomExpr (IntAtom 3)] ()
39 tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]
40 expectedResult = Left (UnhandledExceptionError "1")
41 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)
42 assertEqual "catch error exception from script" expectedResult result
44testNoArgumentAtomFunction :: Test
45testNoArgumentAtomFunction = TestCase $ do
46 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
47 executeTutorialD sess conn "addatomfunction \"mkTest\" Int \"\"\"\\(x :: [Atom]) -> IntAtom 5\"\"\""
48 let attrs = [Attribute "x" IntAtomType]
49 funcAtomExpr = FunctionAtomExpr "mkTest" [] ()
50 tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]
51 expectedResult = mkRelationFromList (V.fromList attrs) [[IntAtom 5]]
52 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)
53 assertEqual "no argument scripted function" expectedResult result