f407d5d · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

nearly all tests pass

f407d5dAgentM6 years ago

src/lib/ProjectM36/TransactionGraph.hs+1−1

compare with master

unifiedsplit

@@ -163,7 +163,7 @@ newTransUncommittedReplace trans@(Transaction tid tinfo (Schemas ctx sschemas))

163 uncommittedReplace marker = marker

164 relvars = relationVariables (concreteDatabaseContext trans)

165 fixedRelvars = M.map (fmap uncommittedReplace) relvars

166− fixedContext = ctx { relationVariables = traceShow ("newReplace", M.lookup "conflictrv" fixedRelvars) fixedRelvars }

166+ fixedContext = ctx { relationVariables = fixedRelvars }

167

168

169

src/lib/ProjectM36/TransactionGraph/Merge.hs−1

@@ -46,7 +46,6 @@ unionMergeRelVars prefer relvarsA relvarsB = do

46 lookupB = findRel relvarsB

47 case (lookupA, lookupB) of

48 (Just relA, Just relB) -> do

49− traceShowM ("unionMerge", relA, relB)

50 relA' <- evalGraphRefRelationalExpr relA

49 relA' <- evalGraphRefRelationalExpr relA

51 relB' <- evalGraphRefRelationalExpr relB

50 relB' <- evalGraphRefRelationalExpr relB

52 case unionMergeRelation prefer relA' relB' of

51 case unionMergeRelation prefer relA' relB' of

test/TransactionGraph/Merge.hs+13−7

@@ -158,7 +158,8 @@ testSelectedBranchMerge = TestCase $ do

158 Right st -> pure (dbc_context st)

159 (_, graph') <- addTransaction "branchB" (createTrans (fakeUUID 3) (TransactionInfo (transactionId branchBTrans NE.:| []) testTime) updatedBranchBContext) graph

160 --create the merge transaction in the graph

161− let eGraph' = mergeTransactions testTime (fakeUUID 4) (fakeUUID 10) (SelectedBranchMergeStrategy "branchA") ("branchA", "branchB") graph'

161+ let eGraph' = runGraphRefRelationalExprM gfEnv $ mergeTransactions testTime (fakeUUID 4) (fakeUUID 10) (SelectedBranchMergeStrategy "branchA") ("branchA", "branchB")

162+ gfEnv = freshGraphRefRelationalExprEnv Nothing graph'

162

163

163 (_, graph'') <- assertEither eGraph'

164 (_, graph'') <- assertEither eGraph'

164

165

@@ -187,13 +188,14 @@ testUnionPreferMergeStrategy = TestCase $ do

187 (_, graph') <- addTransaction "branchA" (createTrans (fakeUUID 3) (TransactionInfo (transactionId branchATrans NE.:| []) testTime) branchAContext) graph

188 (_, graph') <- addTransaction "branchA" (createTrans (fakeUUID 3) (TransactionInfo (transactionId branchATrans NE.:| []) testTime) branchAContext) graph

188 (_, graph'') <- addTransaction "branchB" (createTrans (fakeUUID 4) (TransactionInfo (transactionId branchBTrans NE.:| []) testTime) branchBContext) graph'

189 (_, graph'') <- addTransaction "branchB" (createTrans (fakeUUID 4) (TransactionInfo (transactionId branchBTrans NE.:| []) testTime) branchBContext) graph'

189 -- validate that the conflict is hidden because we preferred a branch

190 -- validate that the conflict is hidden because we preferred a branch

190− let merged = mergeTransactions testTime (fakeUUID 5) (fakeUUID 3) (UnionPreferMergeStrategy "branchB") ("branchA", "branchB") graph''

191+ let merged = runGraphRefRelationalExprM env $ mergeTransactions testTime (fakeUUID 5) (fakeUUID 3) (UnionPreferMergeStrategy "branchB") ("branchA", "branchB")

192+ env = freshGraphRefRelationalExprEnv Nothing graph''

191 case merged of

193 case merged of

192 Left err -> assertFailure ("expected merge success: " ++ show err)

194 Left err -> assertFailure ("expected merge success: " ++ show err)

193 Right (discon, _) -> do

195 Right (discon, _) -> do

194 let Just rvExpr = M.lookup conflictRelVarName (relationVariables (Discon.concreteDatabaseContext discon))

196 let Just rvExpr = M.lookup conflictRelVarName (relationVariables (Discon.concreteDatabaseContext discon))

195 reEnv = freshGraphRefRelationalExprEnv (Just (Discon.concreteDatabaseContext discon)) graph

197 reEnv = freshGraphRefRelationalExprEnv (Just (Discon.concreteDatabaseContext discon)) graph

196− Right rvRel = runGraphRefRelationalExprM reEnv (evalGraphRefRelationalExpr rvExpr)

198+ rvRel <- assertEither $ runGraphRefRelationalExprM reEnv (evalGraphRefRelationalExpr rvExpr)

197 assertEqual "branchB relvar preferred in conflict" branchBRelVar rvRel

199 assertEqual "branchB relvar preferred in conflict" branchBRelVar rvRel

198

200

199-- try various individual component conflicts and check for merge failure

201-- try various individual component conflicts and check for merge failure

@@ -214,14 +216,16 @@ testUnionMergeStrategy = TestCase $ do

214 branchBOnlyRelVarName = "branchBOnlyRelVar"

216 branchBOnlyRelVarName = "branchBOnlyRelVar"

215 branchAOnlyIncDep = InclusionDependency (ExistingRelation relationTrue) (ExistingRelation relationTrue)

217 branchAOnlyIncDep = InclusionDependency (ExistingRelation relationTrue) (ExistingRelation relationTrue)

216 (_, graph') <- addTransaction "branchB" (createTrans (fakeUUID 3) (TransactionInfo (transactionId branchBTrans NE.:| []) testTime) updatedBranchBContext) graph

218 (_, graph') <- addTransaction "branchB" (createTrans (fakeUUID 3) (TransactionInfo (transactionId branchBTrans NE.:| []) testTime) updatedBranchBContext) graph

219+ let env = freshGraphRefRelationalExprEnv Nothing graph'

217− (discon, _) <- assertEither $ mergeTransactions testTime (fakeUUID 5) (fakeUUID 10) UnionMergeStrategy ("branchA", "branchB") graph'

220+ (discon, _) <- assertEither $ runGraphRefRelationalExprM env $ mergeTransactions testTime (fakeUUID 5) (fakeUUID 10) UnionMergeStrategy ("branchA", "branchB")

218 let Just rvExpr = M.lookup branchBOnlyRelVarName (relationVariables (Discon.concreteDatabaseContext discon))

221 let Just rvExpr = M.lookup branchBOnlyRelVarName (relationVariables (Discon.concreteDatabaseContext discon))

219 Right rvRel = runGraphRefRelationalExprM reEnv (evalGraphRefRelationalExpr rvExpr)

222 Right rvRel = runGraphRefRelationalExprM reEnv (evalGraphRefRelationalExpr rvExpr)

220 reEnv = freshGraphRefRelationalExprEnv (Just (Discon.concreteDatabaseContext discon)) graph

223 reEnv = freshGraphRefRelationalExprEnv (Just (Discon.concreteDatabaseContext discon)) graph

221

224

222 assertEqual "branchBOnlyRelVar should appear in the merge" relationTrue rvRel

225 assertEqual "branchBOnlyRelVar should appear in the merge" relationTrue rvRel

223 (_, graph'') <- addTransaction "branchA" (createTrans (fakeUUID 4) (TransactionInfo (transactionId branchATrans NE.:| []) testTime) updatedBranchAContext) graph'

226 (_, graph'') <- addTransaction "branchA" (createTrans (fakeUUID 4) (TransactionInfo (transactionId branchATrans NE.:| []) testTime) updatedBranchAContext) graph'

224− let eMergeGraph = mergeTransactions testTime (fakeUUID 5) (fakeUUID 3) UnionMergeStrategy ("branchA", "branchB") graph''

227+ let eMergeGraph = runGraphRefRelationalExprM gfEnv $ mergeTransactions testTime (fakeUUID 5) (fakeUUID 3) UnionMergeStrategy ("branchA", "branchB")

228+ gfEnv = freshGraphRefRelationalExprEnv Nothing graph''

225 case eMergeGraph of

229 case eMergeGraph of

226 Left err -> assertFailure ("expected merge success: " ++ show err)

230 Left err -> assertFailure ("expected merge success: " ++ show err)

227 Right (_, mergeGraph) -> do

231 Right (_, mergeGraph) -> do

@@ -240,7 +244,8 @@ testUnionMergeStrategy = TestCase $ do

240 let conflictContextA = updatedBranchAContext {relationVariables = M.insert branchBOnlyRelVarName (ExistingRelation conflictRelVar) (relationVariables updatedBranchAContext) }

244 let conflictContextA = updatedBranchAContext {relationVariables = M.insert branchBOnlyRelVarName (ExistingRelation conflictRelVar) (relationVariables updatedBranchAContext) }

241 conflictBranchATrans <- assertMaybe (transactionForHead "branchA" graph'') "retrieving head transaction for expected conflict"

245 conflictBranchATrans <- assertMaybe (transactionForHead "branchA" graph'') "retrieving head transaction for expected conflict"

242 (_, graph''') <- addTransaction "branchA" (createTrans (fakeUUID 6) (TransactionInfo (transactionId conflictBranchATrans NE.:| []) testTime) conflictContextA) graph''

246 (_, graph''') <- addTransaction "branchA" (createTrans (fakeUUID 6) (TransactionInfo (transactionId conflictBranchATrans NE.:| []) testTime) conflictContextA) graph''

243− let failingMerge = mergeTransactions testTime (fakeUUID 5) (fakeUUID 3) UnionMergeStrategy ("branchA", "branchB") graph'''

247+ let failingMerge = runGraphRefRelationalExprM gfEnv' $ mergeTransactions testTime (fakeUUID 5) (fakeUUID 3) UnionMergeStrategy ("branchA", "branchB")

248+ gfEnv' = freshGraphRefRelationalExprEnv Nothing graph'''

244 case failingMerge of

249 case failingMerge of

245 Right _ -> assertFailure "expected merge failure"

250 Right _ -> assertFailure "expected merge failure"

246 Left err -> assertEqual "merge failure" err (MergeTransactionError StrategyViolatesRelationVariableMergeError)

251 Left err -> assertEqual "merge failure" err (MergeTransactionError StrategyViolatesRelationVariableMergeError)

@@ -272,7 +277,8 @@ testUnionMergeIncDepViolation = TestCase $ do

272 (_, graph'') <- addTransaction "branchA" (createTrans (fakeUUID 4) (TransactionInfo (transactionId branchATrans NE.:| []) testTime) branchAContext) graph'

277 (_, graph'') <- addTransaction "branchA" (createTrans (fakeUUID 4) (TransactionInfo (transactionId branchATrans NE.:| []) testTime) branchAContext) graph'

273

278

274 --check that the union merge fails due to a violated constraint

279 --check that the union merge fails due to a violated constraint

275− let eMerge = mergeTransactions testTime (fakeUUID 5) (fakeUUID 3) UnionMergeStrategy ("branchA", "branchB") graph''

280+ let eMerge = runGraphRefRelationalExprM env $ mergeTransactions testTime (fakeUUID 5) (fakeUUID 3) UnionMergeStrategy ("branchA", "branchB")

281+ env = freshGraphRefRelationalExprEnv Nothing graph''

276 case eMerge of

282 case eMerge of

277 Left (InclusionDependencyCheckError incDepName') -> assertEqual "incdep violation name" incDepName incDepName'

283 Left (InclusionDependencyCheckError incDepName') -> assertEqual "incdep violation name" incDepName incDepName'

278 Left err -> assertFailure ("other error: " ++ show err)

284 Left err -> assertFailure ("other error: " ++ show err)