git.iko.soy/project-m36
on 52182bc help sign in
project-m36/test/TutorialD/Interpreter/DatabaseContextFunctionScript.hs
58 lines 3.7 kB history raw
1import TutorialD.Interpreter.TestBase
2import System.Exit
3import Test.HUnit
4import ProjectM36.Client
5import ProjectM36.Relation
6import qualified Data.Text as T
8main :: IO ()
9main = do
10 tcounts <- runTestTT (TestList [testBasicDBCFunction,
11 testErrorDBCFunction,
12 testExceptionDBCFunction,
13 testDBCFunctionWithAtomArguments
14 ])
15 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
17testBasicDBCFunction :: Test
18testBasicDBCFunction = TestCase $ do
19 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
20 let addfunc = "adddatabasecontextfunction \"addTrue2\" DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext \"\"\"(\\[] ctx -> executeDatabaseContextExpr (Assign \"true2\" (ExistingRelation relationTrue)) ctx) :: [Atom] -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext\"\"\""
21 executeTutorialD sess conn addfunc
22 executeTutorialD sess conn "execute addTrue2()"
23 {-
24 let true2Expr = RelationVariable "true2" ()
25 result <- executeRelationalExpr sess conn true2Expr
26 assertEqual "simple atom function equality" (Right relationTrue) result-}
28testErrorDBCFunction :: Test
29testErrorDBCFunction = TestCase $ do
30 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
31 let addfunc = "adddatabasecontextfunction \"retErr\" DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext \"\"\"(\\[] ctx -> Left (DatabaseContextFunctionUserError \"err\")) :: [Atom] -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext\"\"\""
32 executeTutorialD sess conn addfunc
33 expectTutorialDErr sess conn (T.isPrefixOf "DatabaseContextFunctionUserError (DatabaseContextFunctionUserError \"err\")") "execute retErr()"
35testExceptionDBCFunction :: Test
36testExceptionDBCFunction = TestCase $ do
37 -- throw an error, make sure it is caught- it might not be caught, for example, if the function is not forced
38 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
39 let addfunc = "adddatabasecontextfunction \"bomb\" DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext \"\"\"(\\[] _ -> error \"boom\") :: [Atom] -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext\"\"\""
40 executeTutorialD sess conn addfunc
41 expectTutorialDErr sess conn ("UnhandledExceptionError" `T.isPrefixOf`) "execute bomb()"
44testDBCFunctionWithAtomArguments :: Test
45testDBCFunctionWithAtomArguments = TestCase $ do
46 --test function with creation of a relvar with some arguments
47 (sess, conn) <- dateExamplesConnection emptyNotificationCallback
48 let addfunc = "adddatabasecontextfunction \"multiArgFunc\" Integer -> Text -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext \"\"\"(\\(age:name:_) ctx -> executeDatabaseContextExpr (Assign \"person\" (MakeRelationFromExprs Nothing [TupleExpr (fromList [(\"name\", NakedAtomExpr name), (\"age\", NakedAtomExpr age)])])) ctx) :: [Atom] -> DatabaseContext -> Either DatabaseContextFunctionError DatabaseContext\"\"\""
49 executeTutorialD sess conn addfunc
50 executeTutorialD sess conn "execute multiArgFunc(30,\"Steve\")"
51 result <- executeRelationalExpr sess conn (RelationVariable "person" ())
52 let expectedPerson = mkRelationFromList (attributesFromList [Attribute "name" TextAtomType,
53 Attribute "age" IntegerAtomType]) [
54 [TextAtom "Steve", IntegerAtom 30]]
55 assertEqual "person relation" expectedPerson result
56 expectTutorialDErr sess conn (T.isPrefixOf "AtomTypeMismatchError") "execute multiArgFunc(\"fail\", \"fail\")"