on fd05d50 help sign in
68 lines 2.4 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 ProjectM36.Error
11import qualified Data.Vector as V
13main :: IO ()
14main = do
15 tcounts <- runTestTT testList
16 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
18testList :: Test
19testList = TestList [testSimpleCommitSuccess, testSimpleCommitFailure]
21assertEither :: (Show a) => IO (Either a b) -> IO b
22assertEither x = do
23 res <- x
24 case res of
25 Left err -> assertFailure (show err) >> undefined
26 Right val -> pure val
28testSimpleCommitSuccess :: Test
29testSimpleCommitSuccess = TestCase $
30 withSystemTempDirectory "m36tempdb" $ \tempdir -> do
31 let connInfo = InProcessConnectionInfo (MinimalPersistence (tempdir </> "db")) emptyNotificationCallback []
32 relExpr = Union (RelationVariable "x" ()) (RelationVariable "y" ())
34 dbconn <- assertEither (simpleConnectProjectM36 connInfo)
35 Right rel <- withTransaction dbconn $ do
37 execute (Assign "x" (ExistingRelation relationTrue))
38 execute (Assign "y" (ExistingRelation relationFalse))
39 query relExpr
41 assertEqual "true/false simple" relationTrue rel
42 -- re-open with standard API and validate that the relvars are available
43 conn <- assertEither $ C.connectProjectM36 connInfo
45 sess <- assertEither $ C.createSessionAtHead conn "master"
46 eRes <- C.executeRelationalExpr sess conn relExpr
47 assertEqual "x and y" (Right relationTrue) eRes
49testSimpleCommitFailure :: Test
50testSimpleCommitFailure = TestCase $ do
51 let failAttrs = attributesFromList [Attribute "fail" IntAtomType]
52 err <- withSystemTempDirectory "m36tempdb" $ \tempdir -> do
53 let connInfo = InProcessConnectionInfo (MinimalPersistence (tempdir </> "db")) emptyNotificationCallback []
54 dbconn <- assertEither (simpleConnectProjectM36 connInfo)
55 withTransaction dbconn $ do
56 execute $ Assign "x" (ExistingRelation relationTrue)
57 --cause error
58 execute $ Assign "x" (MakeStaticRelation failAttrs emptyTupleSet)
59 let expectedErr = Left (RelError (RelVarAssignmentTypeMismatchError V.empty failAttrs))
60 assertEqual "dbc error" expectedErr err