393d5fa · project-m36 · git.iko.soy

git.iko.soy/project-m36

WIP all tests compile

databasecontextfunction test failing

commit393d5fa54313f75aa839bda1fd8cfe999428b912 authorAgentM <agentm@themactionfaction.com> dateSun 30 Jul 2017, 09:23 (9 years ago) parent91d6fa9

5 files changed+19−19

compare with master

unifiedsplit

src/lib/ProjectM36/Client.hs+3−3 src/lib/ProjectM36/Server/EntryPoints.hs+1−1 test/MultiProcessDatabaseAccess.hs+9−9 test/Relation/Atomable.hs+1−1 test/Server/Main.hs+5−5

src/lib/ProjectM36/Client.hs+3−3

@@ -855,14 +855,14 @@ relationVariablesAsRelation sessionId (InProcessConnection conf) = do

855855relationVariablesAsRelation sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveRelationVariableSummary sessionId)

856856

857857-- | Returns the transaction id for the connection's disconnected transaction committed parent transaction.

858−headTransactionId :: SessionId -> Connection -> IO (Maybe TransactionId)

858+headTransactionId :: SessionId -> Connection -> IO (Either RelationalError TransactionId)

859859headTransactionId sessionId (InProcessConnection conf) = do

860860 let sessions = ipSessions conf

861861 atomically $ do

862862 eSession <- sessionForSessionId sessionId sessions

863863 case eSession of

864− Left _ -> pure Nothing

865− Right session -> pure $ Just (Sess.parentId session)

864+ Left err -> pure (Left err)

865+ Right session -> pure $ Right (Sess.parentId session)

866866headTransactionId sessionId conn@(RemoteProcessConnection _) = remoteCall conn (RetrieveHeadTransactionId sessionId)

867867

868868headNameSTM_ :: SessionId -> Sessions -> TVar TransactionGraph -> STM (Either RelationalError HeadName)

src/lib/ProjectM36/Server/EntryPoints.hs+1−1

@@ -87,7 +87,7 @@ handleRetrieveTransactionGraph ti sessionId conn = do

8787 ret <- timeoutOrDie ti (transactionGraphAsRelation sessionId conn)

8888 reply ret conn

8989

90−handleRetrieveHeadTransactionId :: Timeout -> SessionId -> Connection -> Reply (Maybe TransactionId)

90+handleRetrieveHeadTransactionId :: Timeout -> SessionId -> Connection -> Reply (Either RelationalError TransactionId)

9191handleRetrieveHeadTransactionId ti sessionId conn = do

9292 ret <- timeoutOrDie ti (headTransactionId sessionId conn)

9393 reply ret conn

test/MultiProcessDatabaseAccess.hs+9−9

@@ -41,13 +41,13 @@ testMultipleProcessAccess = TestCase $ do

4141 session1 <- assertIOEither (createSessionAtHead master conn1)

4242 session2 <- assertIOEither (createSessionAtHead master conn2)

4343 --add a commit on conn1 which conn2 doesn't know about

44− assertIONothing $ executeDatabaseContextExpr session1 conn1 dudExpr

45− assertIONothing $ commit session1 conn1 ForbidEmptyCommitOption

44+ assertIOEither $ executeDatabaseContextExpr session1 conn1 dudExpr

45+ assertIOEither $ commit session1 conn1

4646

47− assertIONothing $ executeDatabaseContextExpr session2 conn2 dudExpr

48− mHeadId <- headTransactionId session2 conn2

49− headId <- case mHeadId of

50− Nothing -> assertFailure "headTransactionId failed" >> undefined

51− Just x -> pure x

52− res <- commit session2 conn2 ForbidEmptyCommitOption

53− assertEqual "commit should fail" (Just (TransactionIsNotAHeadError headId)) res

47+ assertIOEither $ executeDatabaseContextExpr session2 conn2 dudExpr

48+ eHeadId <- headTransactionId session2 conn2

49+ headId <- case eHeadId of

50+ Left err -> assertFailure ("headTransactionId failed: " ++ show err) >> undefined

51+ Right x -> pure x

52+ res <- commit session2 conn2

53+ assertEqual "commit should fail" (Left (TransactionIsNotAHeadError headId)) res

test/Relation/Atomable.hs+1−1

@@ -108,7 +108,7 @@ testADT5 = TestCase $ do

108108 assertEqual "record-based ADT" example (fromAtom (toAtom example))

109109

110110checkExecuteDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO ()

111−checkExecuteDatabaseContextExpr sessionId dbconn expr = executeDatabaseContextExpr sessionId dbconn expr >>= maybe (pure ()) (\err -> assertFailure (show err))

111+checkExecuteDatabaseContextExpr sessionId dbconn expr = executeDatabaseContextExpr sessionId dbconn expr >>= either (\err -> assertFailure (show err)) (const (pure ()))

112112

113113testListInstance :: Test

114114testListInstance = TestCase $ do

test/Server/Main.hs+5−5

@@ -152,7 +152,7 @@ testTransactionGraphAsRelation sessionId conn = TestCase $ do

152152testHeadTransactionId :: SessionId -> Connection -> Test

153153testHeadTransactionId sessionId conn = TestCase $ do

154154 uuid <- headTransactionId sessionId conn

155− assertBool "invalid head transaction uuid" (isJust uuid)

155+ assertBool "invalid head transaction uuid" (isRight uuid)

156156 pure ()

157157

158158testHeadName :: SessionId -> Connection -> Test

@@ -174,10 +174,10 @@ testSession _ conn = TestCase $ do

174174 case eSessionId1 of

175175 Left _ -> assertFailure "invalid session"

176176 Right sessionId1 -> do

177− mHeadId <- headTransactionId sessionId1 conn

178− case mHeadId of

179− Nothing -> assertFailure "invalid head id"

180− Just headId -> do

177+ eHeadId <- headTransactionId sessionId1 conn

178+ case eHeadId of

179+ Left err -> assertFailure "invalid head id"

180+ Right headId -> do

181181 eSessionId2 <- createSessionAtCommit headId conn

182182 assertBool ("invalid session: " ++ show eSessionId2) (isRight eSessionId2)

183183 closeSession sessionId1 conn