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