on 5ffcd7d help sign in
67 lines 2.3 kB history raw
1import ProjectM36.Client.Simple
2import Test.HUnit
3import System.Exit
4import ProjectM36.Relation
5import qualified ProjectM36.Client as C
6import System.IO.Temp
7import System.FilePath
8import ProjectM36.TupleSet
9import ProjectM36.Attribute
10import qualified Data.Vector as V
12main :: IO ()
13main = do
14 tcounts <- runTestTT testList
15 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
17testList :: Test
18testList = TestList [testSimpleCommitSuccess, testSimpleCommitFailure]
20assertEither :: (Show a) => IO (Either a b) -> IO b
21assertEither x = do
22 res <- x
23 case res of
24 Left err -> assertFailure (show err) >> undefined
25 Right val -> pure val
27testSimpleCommitSuccess :: Test
28testSimpleCommitSuccess = TestCase $
29 withSystemTempDirectory "m36tempdb" $ \tempdir -> do
30 let connInfo = InProcessConnectionInfo (MinimalPersistence (tempdir </> "db")) emptyNotificationCallback []
31 relExpr = Union (RelationVariable "x" ()) (RelationVariable "y" ())
33 dbconn <- assertEither (simpleConnectProjectM36 connInfo)
34 Right rel <- withTransaction dbconn $ do
36 execute (Assign "x" (ExistingRelation relationTrue))
37 execute (Assign "y" (ExistingRelation relationFalse))
38 query relExpr
40 assertEqual "true/false simple" relationTrue rel
41 -- re-open with standard API and validate that the relvars are available
42 conn <- assertEither $ C.connectProjectM36 connInfo
44 sess <- assertEither $ C.createSessionAtHead conn "master"
45 eRes <- C.executeRelationalExpr sess conn relExpr
46 assertEqual "x and y" (Right relationTrue) eRes
48testSimpleCommitFailure :: Test
49testSimpleCommitFailure = TestCase $ do
50 let failAttrs = attributesFromList [Attribute "fail" IntAtomType]
51 err <- withSystemTempDirectory "m36tempdb" $ \tempdir -> do
52 let connInfo = InProcessConnectionInfo (MinimalPersistence (tempdir </> "db")) emptyNotificationCallback []
53 dbconn <- assertEither (simpleConnectProjectM36 connInfo)
54 withTransaction dbconn $ do
55 execute $ Assign "x" (ExistingRelation relationTrue)
56 --cause error
57 execute $ Assign "x" (MakeStaticRelation failAttrs emptyTupleSet)
58 let expectedErr = Left (RelError (RelationTypeMismatchError V.empty failAttrs))
59 assertEqual "dbc error" expectedErr err