@@ -13,16 +13,17 @@ import ProjectM36.TupleSet
1313import System.Exit
1414import Control.Concurrent
1515
16−testList :: Connection -> Test
17−testList conn = TestList $ map (\t -> t conn) [testRelationalExpr,
18− testDatabaseContextExpr,
19− testGraphExpr,
20− testTypeForRelationalExpr,
21− testPlanForDatabaseContextExpr,
22− testTransactionGraphAsRelation,
23− testHeadTransactionUUID,
24− testHeadName
25− ]
16+testList :: SessionId -> Connection -> Test
17+testList sessionId conn = TestList $ map (\t -> t sessionId conn) [
18+ testRelationalExpr,
19+ testDatabaseContextExpr,
20+ testGraphExpr,
21+ testTypeForRelationalExpr,
22+ testPlanForDatabaseContextExpr,
23+ testTransactionGraphAsRelation,
24+ testHeadTransactionUUID,
25+ testHeadName
26+ ]
2627
2728main :: IO ()
2829main = do
@@ -30,17 +31,24 @@ main = do
3031 eTestConn <- testConnection port
3132 case eTestConn of
3233 Left err -> putStrLn (show err) >> exitFailure
33− Right testConn -> do
34− tcounts <- runTestTT (testList testConn)
34+ Right (session, testConn) -> do
35+ tcounts <- runTestTT (testList session testConn)
3536 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
3637
3738testDatabaseName :: DatabaseName
3839testDatabaseName = "test"
3940
40−testConnection :: Port -> IO (Either ConnectionError Connection)
41+testConnection :: Port -> IO (Either ConnectionError (SessionId, Connection))
4142testConnection port = do
4243 let connInfo = RemoteProcessConnectionInfo testDatabaseName (createNodeId "127.0.0.1" port)
43− connectProjectM36 connInfo
44+ eConn <- connectProjectM36 connInfo
45+ case eConn of
46+ Left err -> pure $ Left err
47+ Right conn -> do
48+ eSessionId <- createSessionAtHead defaultHeadName conn
49+ case eSessionId of
50+ Left _ -> error "failed to create session"
51+ Right sessionId -> pure $ Right (sessionId, conn)
4452
4553-- | A version of 'launchServer' which returns the port on which the server is listening on a secondary thread
4654launchTestServer :: IO (Port)
@@ -50,65 +58,65 @@ launchTestServer = do
5058 _ <- forkIO $ launchServer config (Just portVar) >> pure ()
5159 takeMVar portVar
5260
53−testRelationalExpr :: Connection -> Test
54−testRelationalExpr conn = TestCase $ do
55− relResult <- executeRelationalExpr conn (RelationVariable "true")
61+testRelationalExpr :: SessionId -> Connection -> Test
62+testRelationalExpr sessionId conn = TestCase $ do
63+ relResult <- executeRelationalExpr sessionId conn (RelationVariable "true")
5664 assertEqual "invalid relation result" (Right relationTrue) relResult
5765
58−testDatabaseContextExpr :: Connection -> Test
59−testDatabaseContextExpr conn = TestCase $ do
66+testDatabaseContextExpr :: SessionId -> Connection -> Test
67+testDatabaseContextExpr sessionId conn = TestCase $ do
6068 let attrs = attributesFromList [Attribute "x" intAtomType]
6169 testrv = "testrv"
62− dbResult <- executeDatabaseContextExpr conn (Define testrv attrs)
70+ dbResult <- executeDatabaseContextExpr sessionId conn (Define testrv attrs)
6371 case dbResult of
6472 Just err -> assertFailure (show err)
6573 Nothing -> do
66− eRel <- executeRelationalExpr conn (RelationVariable testrv)
74+ eRel <- executeRelationalExpr sessionId conn (RelationVariable testrv)
6775 let expected = mkRelation attrs emptyTupleSet
6876 case eRel of
6977 Left err -> assertFailure (show err)
7078 Right rel -> assertEqual "dbcontext definition failed" expected (Right rel)
7179
72−testGraphExpr :: Connection -> Test
73−testGraphExpr conn = TestCase $ do
74− graphResult <- executeGraphExpr conn (JumpToHead "master")
80+testGraphExpr :: SessionId -> Connection -> Test
81+testGraphExpr sessionId conn = TestCase $ do
82+ graphResult <- executeGraphExpr sessionId conn (JumpToHead "master")
7583 case graphResult of
7684 Just err -> assertFailure (show err)
7785 Nothing -> pure ()
7886
79−testTypeForRelationalExpr :: Connection -> Test
80−testTypeForRelationalExpr conn = TestCase $ do
81− relResult <- typeForRelationalExpr conn (RelationVariable "true")
87+testTypeForRelationalExpr :: SessionId -> Connection -> Test
88+testTypeForRelationalExpr sessionId conn = TestCase $ do
89+ relResult <- typeForRelationalExpr sessionId conn (RelationVariable "true")
8290 case relResult of
8391 Left err -> assertFailure (show err)
8492 Right rel -> assertEqual "typeForRelationalExpr failure" relationFalse rel
8593
86−testPlanForDatabaseContextExpr :: Connection -> Test
87−testPlanForDatabaseContextExpr conn = TestCase $ do
94+testPlanForDatabaseContextExpr :: SessionId -> Connection -> Test
95+testPlanForDatabaseContextExpr sessionId conn = TestCase $ do
8896 let attrs = attributesFromList [Attribute "x" intAtomType]
8997 testrv = "testrv"
9098 dbExpr = Define testrv attrs
91− planResult <- planForDatabaseContextExpr conn dbExpr
99+ planResult <- planForDatabaseContextExpr sessionId conn dbExpr
92100 case planResult of
93101 Left err -> assertFailure (show err)
94102 Right plan -> assertEqual "planForDatabaseContextExpr failure" dbExpr plan
95103
96104
97−testTransactionGraphAsRelation :: Connection -> Test
98−testTransactionGraphAsRelation conn = TestCase $ do
99− eGraph <- transactionGraphAsRelation conn
105+testTransactionGraphAsRelation :: SessionId -> Connection -> Test
106+testTransactionGraphAsRelation sessionId conn = TestCase $ do
107+ eGraph <- transactionGraphAsRelation sessionId conn
100108 case eGraph of
101109 Left err -> assertFailure (show err)
102110 Right _ -> pure ()
103111
104−testHeadTransactionUUID :: Connection -> Test
105−testHeadTransactionUUID conn = TestCase $ do
106− _ <- headTransactionUUID conn
112+testHeadTransactionUUID :: SessionId -> Connection -> Test
113+testHeadTransactionUUID sessionId conn = TestCase $ do
114+ _ <- headTransactionUUID sessionId conn
107115 pure ()
108116
109−testHeadName :: Connection -> Test
110−testHeadName conn = TestCase $ do
111− mHeadName <- headName conn
117+testHeadName :: SessionId -> Connection -> Test
118+testHeadName sessionId conn = TestCase $ do
119+ mHeadName <- headName sessionId conn
112120 assertEqual "headName failure" (Just "master") mHeadName
113121
114122