git.iko.soy/project-m36
on master help sign in
nearly all tests pass
commitf407d5d8e0f030981bbef24670e3fa370dfd6b79 authorAgentM <agentm@themactionfaction.com> dateTue 5 May 2020, 22:57 (6 years ago) parenta76ee6f
3 files changed+14−9
compare with master
unifiedsplit
src/lib/ProjectM36/TransactionGraph.hs+1−1 src/lib/ProjectM36/TransactionGraph/Merge.hs−1 test/TransactionGraph/Merge.hs+13−7
src/lib/ProjectM36/TransactionGraph.hs+1−1
@@ -163,7 +163,7 @@ newTransUncommittedReplace trans@(Transaction tid tinfo (Schemas ctx sschemas))
163163 uncommittedReplace marker = marker
164164 relvars = relationVariables (concreteDatabaseContext trans)
165165 fixedRelvars = M.map (fmap uncommittedReplace) relvars
166− fixedContext = ctx { relationVariables = traceShow ("newReplace", M.lookup "conflictrv" fixedRelvars) fixedRelvars }
166+ fixedContext = ctx { relationVariables = fixedRelvars }
167167
168168
169169
src/lib/ProjectM36/TransactionGraph/Merge.hs−1
@@ -46,7 +46,6 @@ unionMergeRelVars prefer relvarsA relvarsB = do
4646 lookupB = findRel relvarsB
4747 case (lookupA, lookupB) of
4848 (Just relA, Just relB) -> do
49− traceShowM ("unionMerge", relA, relB)
5049 relA' <- evalGraphRefRelationalExpr relA
5150 relB' <- evalGraphRefRelationalExpr relB
5251 case unionMergeRelation prefer relA' relB' of
test/TransactionGraph/Merge.hs+13−7
@@ -158,7 +158,8 @@ testSelectedBranchMerge = TestCase $ do
158158 Right st -> pure (dbc_context st)
159159 (_, graph') <- addTransaction "branchB" (createTrans (fakeUUID 3) (TransactionInfo (transactionId branchBTrans NE.:| []) testTime) updatedBranchBContext) graph
160160 --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'
162163
163164 (_, graph'') <- assertEither eGraph'
164165
@@ -187,13 +188,14 @@ testUnionPreferMergeStrategy = TestCase $ do
187188 (_, graph') <- addTransaction "branchA" (createTrans (fakeUUID 3) (TransactionInfo (transactionId branchATrans NE.:| []) testTime) branchAContext) graph
188189 (_, graph'') <- addTransaction "branchB" (createTrans (fakeUUID 4) (TransactionInfo (transactionId branchBTrans NE.:| []) testTime) branchBContext) graph'
189190 -- 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''
191193 case merged of
192194 Left err -> assertFailure ("expected merge success: " ++ show err)
193195 Right (discon, _) -> do
194196 let Just rvExpr = M.lookup conflictRelVarName (relationVariables (Discon.concreteDatabaseContext discon))
195197 reEnv = freshGraphRefRelationalExprEnv (Just (Discon.concreteDatabaseContext discon)) graph
196− Right rvRel = runGraphRefRelationalExprM reEnv (evalGraphRefRelationalExpr rvExpr)
198+ rvRel <- assertEither $ runGraphRefRelationalExprM reEnv (evalGraphRefRelationalExpr rvExpr)
197199 assertEqual "branchB relvar preferred in conflict" branchBRelVar rvRel
198200
199201-- try various individual component conflicts and check for merge failure
@@ -214,14 +216,16 @@ testUnionMergeStrategy = TestCase $ do
214216 branchBOnlyRelVarName = "branchBOnlyRelVar"
215217 branchAOnlyIncDep = InclusionDependency (ExistingRelation relationTrue) (ExistingRelation relationTrue)
216218 (_, graph') <- addTransaction "branchB" (createTrans (fakeUUID 3) (TransactionInfo (transactionId branchBTrans NE.:| []) testTime) updatedBranchBContext) graph
217− (discon, _) <- assertEither $ mergeTransactions testTime (fakeUUID 5) (fakeUUID 10) UnionMergeStrategy ("branchA", "branchB") graph'
219+ let env = freshGraphRefRelationalExprEnv Nothing graph'
220+ (discon, _) <- assertEither $ runGraphRefRelationalExprM env $ mergeTransactions testTime (fakeUUID 5) (fakeUUID 10) UnionMergeStrategy ("branchA", "branchB")
218221 let Just rvExpr = M.lookup branchBOnlyRelVarName (relationVariables (Discon.concreteDatabaseContext discon))
219222 Right rvRel = runGraphRefRelationalExprM reEnv (evalGraphRefRelationalExpr rvExpr)
220223 reEnv = freshGraphRefRelationalExprEnv (Just (Discon.concreteDatabaseContext discon)) graph
221224
222225 assertEqual "branchBOnlyRelVar should appear in the merge" relationTrue rvRel
223226 (_, 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''
225229 case eMergeGraph of
226230 Left err -> assertFailure ("expected merge success: " ++ show err)
227231 Right (_, mergeGraph) -> do
@@ -240,7 +244,8 @@ testUnionMergeStrategy = TestCase $ do
240244 let conflictContextA = updatedBranchAContext {relationVariables = M.insert branchBOnlyRelVarName (ExistingRelation conflictRelVar) (relationVariables updatedBranchAContext) }
241245 conflictBranchATrans <- assertMaybe (transactionForHead "branchA" graph'') "retrieving head transaction for expected conflict"
242246 (_, 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'''
244249 case failingMerge of
245250 Right _ -> assertFailure "expected merge failure"
246251 Left err -> assertEqual "merge failure" err (MergeTransactionError StrategyViolatesRelationVariableMergeError)
@@ -272,7 +277,8 @@ testUnionMergeIncDepViolation = TestCase $ do
272277 (_, graph'') <- addTransaction "branchA" (createTrans (fakeUUID 4) (TransactionInfo (transactionId branchATrans NE.:| []) testTime) branchAContext) graph'
273278
274279 --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''
276282 case eMerge of
277283 Left (InclusionDependencyCheckError incDepName') -> assertEqual "incdep violation name" incDepName incDepName'
278284 Left err -> assertFailure ("other error: " ++ show err)