tests/digraph.slate

   1 testing UnitTests define: #Digraph &parents: {TestCase}.
   2
   3 tc@(UnitTests Digraph traits) newNode: obj
   4 [
   5   Digraph Node new `>> [object: obj. ]
   6 ].
   7
   8 tc@(UnitTests Digraph traits) generatingBlockBetween: lower and: upper
   9 [
  10   [| :node obj |
  11     obj := node object.
  12     obj > lower /\ [obj < upper]
  13       ifTrue: [{obj - 1. obj + 1}]
  14       ifFalse: [
  15         obj > lower ifTrue: [{obj - 1}]
  16                     ifFalse: [{obj + 1}]]]
  17 ].
  18
  19 tc@(UnitTests Digraph traits) testCreationByNonGeneratingBlock
  20 [
  21   node ::= tc newNode: 5.
  22   graph ::= Digraph newFrom: node walking: [| :n | #{}].
  23   tc assert: graph allNodes = (Set newWith: node)
  24     description: 'Method #newFrom:walking: failed for non-generative block.'.
  25 ].
  26
  27 tc@(UnitTests Digraph traits) testCreationByWalkingWithABlock
  28 [
  29   nodes ::= {1. 2. 3. 4. 5. 6. 7. 8. 9} as: Set.
  30   graph ::= Digraph newFrom: (tc newNode: 5)
  31     walking: (tc generatingBlockBetween: 1 and: 9).
  32   tc assert: nodes = (graph allNodes collect: [| :e | e object])
  33     description: 'Method #newFrom:walking: failed (symmetric generation).'.
  34 ].
  35
  36 tc@(UnitTests Digraph traits) testAsymmetricCreationByWalkingWithABlock
  37 [| graph |
  38   nodes ::= {1. 2. 3. 4. 5. 6} as: Set.
  39   block ::= tc generatingBlockBetween: 1 and: 6.
  40   graph := Digraph newFrom: (tc newNode: 1) walking: block.
  41   tc assert: nodes = (graph allNodes collect: [| :e | e object])
  42     description: 'Method #newFrom:walking: failed (asymmetric generation 1).'.
  43   graph := Digraph newFrom: (tc newNode: 6) walking: block.
  44   tc assert: nodes = (graph allNodes collect: [| :e | e object])
  45     description: 'Method #newFrom:walking: failed (asymmetric generation 2).'.
  46 ].
  47
  48 tc@(UnitTests Digraph traits) suite
  49 [
  50   tc suiteForSelectors: {
  51     #testCreationByNonGeneratingBlock.
  52     #testCreationByWalkingWithABlock.
  53     #testAsymmetricCreationByWalkingWithABlock
  54   }
  55 ].
  56
  57 testing UnitTests define: #KeyedDigraph &parents: {UnitTests Digraph}.
  58
  59 tc@(UnitTests KeyedDigraph traits) newNode: obj
  60 [
  61   KeyedDigraph Node new `>> [object: obj. ]
  62 ].
  63
  64 tc@(UnitTests KeyedDigraph traits) keysBetween: lower and: upper
  65 [
  66   answer ::= SortedSet new.
  67   lower upTo: upper do: [| :i | answer add: i].
  68   answer
  69 ].
  70
  71 tc@(UnitTests KeyedDigraph traits) testNodeTransitionMatching
  72 [| upperBound |
  73   node1 ::= tc newNode: 1.
  74   node2 ::= tc newNode: 2.
  75   targets ::= {tc newNode: 3. tc newNode: 4. tc newNode: 5}.
  76   "tc assert: (node1 transitionsMatch: node2) = False
  77     description: 'Unrelated nodes should not match.'."
  78   upperBound := 2.
  79   targets do: [| :targetNode |
  80                node1 addEdgeTo: targetNode keys: (tc keysBetween: 1 and: upperBound).
  81                node2 addEdgeTo: targetNode keys: (tc keysBetween: 1 and: upperBound).
  82                upperBound += 1].
  83   tc assert: (node1 transitionsMatch: node2) = True
  84     description: 'Nodes with same targets and transitions should match'.
  85   node1 transitions do: [| :edge | edge keys add: 4].
  86   tc assert: (node1 transitionsMatch: node2) = False
  87     description: 'Nodes with differently keyed transitions should not match.'.
  88   node2 transitions do: [| :edge | edge keys add: 4].
  89   node1 addEdgeTo: node2 keys: (tc keysBetween: 1 and: 5).
  90   node2 addEdgeTo: node1 keys: (tc keysBetween: 1 and: 5).
  91   tc assert: (node1 transitionsMatch: node2) = True
  92     description: 'Nodes with symmetric transitions should match.'.
  93 ].
  94
  95 tc@(UnitTests KeyedDigraph traits) testCommutativityOFNodeTransitionMatching
  96 [| upperBound |
  97   node1 ::= tc newNode: 1.
  98   node2 ::= tc newNode: 2.
  99   targets ::= {tc newNode: 3. tc newNode: 4. tc newNode: 5}.
 100   upperBound := 2.
 101   targets do: [| :targetNode |
 102                node1 addEdgeTo: targetNode keys: (tc keysBetween: 1 and: upperBound).
 103                node2 addEdgeTo: targetNode keys: (tc keysBetween: 1 and: upperBound).
 104                upperBound += 1].
 105   tc assert: (node1 transitionsMatch: node2) = (node2 transitionsMatch: node1)
 106     description: 'Node transition matching should be commutative (both True).'.
 107   node1 transitions do: [| :edge | edge keys add: 4].
 108   tc assert: (node1 transitionsMatch: node2) = (node2 transitionsMatch: node1)
 109     description: 'Node transition matching should be commutative (both False).'.
 110   node2 transitions do: [| :edge | edge keys add: 4].
 111   node1 addEdgeTo: node2 keys: (tc keysBetween: 1 and: 5).
 112   node2 addEdgeTo: node1 keys: (tc keysBetween: 1 and: 5).
 113   tc assert: (node1 transitionsMatch: node2) = (node2 transitionsMatch: node1)
 114     description: 'Node transition matching should be commutative (both True.'.
 115 ].
 116
 117 tc@(UnitTests KeyedDigraph traits) testEdgeMerging
 118 [
 119   startNode ::= tc newNode: 'start'.
 120   endNode ::= tc newNode: 'end'.
 121   startNode addEdgeTo: endNode keys: (tc keysBetween: 1 and: 3).
 122   startNode addEdgeTo: endNode keys: (tc keysBetween: 4 and: 7).
 123   mergedKeys ::= tc keysBetween: 1 and: 7.
 124   startNode mergeTransitions.
 125   tc assert: startNode transitions size = 1
 126     /\ [(startNode transitions detect: [| :edge | edge keys = mergedKeys])
 127           ifNil: [False]
 128           ifNotNil: [True]]
 129     description: 'Edges should have been merged.'.
 130 ].
 131
 132 tc@(UnitTests KeyedDigraph traits) testDuplicateDeletion
 133 [
 134   startNode ::= tc newNode: 'start'.
 135   intermediate ::= tc newNode: 'intermediate'.
 136   dupl1 ::= tc newNode: 'first'.
 137   dupl2 ::= tc newNode: 'second'.
 138   endNode ::= tc newNode: 'end'.
 139   startNode addEdgeTo: intermediate keys: (tc keysBetween: 1 and: 3).
 140   startNode addEdgeTo: intermediate keys: (tc keysBetween: 4 and: 7).
 141   intermediate addEdgeTo: dupl1 keys: (tc keysBetween: 8 and: 9).
 142   startNode addEdgeTo: dupl2 keys: (tc keysBetween: 3 and: 5).
 143   dupl1 addEdgeTo: endNode keys: (tc keysBetween: 2 and: 4).
 144   dupl2 addEdgeTo: endNode keys: (tc keysBetween: 2 and: 4).
 145   startNode removeDuplicateNodes.
 146   tc assert: dupl1 == dupl2
 147     description: 'Duplicate removal should make duplicates the same object.'.
 148 ].
 149
 150 tc@(UnitTests KeyedDigraph traits) suite
 151 [
 152   tc suiteForSelectors: {
 153     #testNodeTransitionMatching.
 154     #testCommutativityOFNodeTransitionMatching.
 155     #testEdgeMerging.
 156     #testDuplicateDeletion
 157   }
 158 ].