git.iko.soy/project-m36
on 62_python_dbapi help sign in
project-m36/test/TutorialD/Interpreter/AtomFunctionScript.hs
56 lines 2.8 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 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)
41 assertBool "catch error exception from script" (case result of
42 Left (UnhandledExceptionError _) -> True
43 _ -> False)
45testNoArgumentAtomFunction :: Test
46testNoArgumentAtomFunction = TestCase $ do
47 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
48 executeTutorialD sess conn "addatomfunction \"mkTest\" Int \"\"\"\\(x :: [Atom]) -> IntAtom 5\"\"\""
49 let attrs = [Attribute "x" IntAtomType]
50 funcAtomExpr = FunctionAtomExpr "mkTest" [] ()
51 tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]
52 expectedResult = mkRelationFromList (V.fromList attrs) [[IntAtom 5]]
53 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)
54 assertEqual "no argument scripted function" expectedResult result