From 908fcfbce5ddb7a38594ecbdd7bdf83e005ed52d Mon Sep 17 00:00:00 2001 From: CyrilFerlicot Date: Mon, 4 Jul 2022 14:42:10 +0200 Subject: [PATCH] feat: Add a way to send a notification to the user through a visualization --- .github/workflows/continuous.yml | 2 +- README.md | 4 +- .../ManifestTelescopeCoreTests.class.st | 16 +- .../TLAbstractNodeTest.class.st | 56 +-- .../TLCompositeNodeTest.class.st | 142 +++---- .../TLConnectActionTest.class.st | 72 ++-- .../TLConnectWithEntityActionTest.class.st | 76 ++-- .../TLConnectionsTest.class.st | 254 ++++++------ .../TLConnectionsWithEntityTest.class.st | 166 ++++---- .../TLConnectorTest.class.st | 170 ++++---- .../TLDrawableTest.class.st | 74 ++-- .../TLEntitiesGroupTest.class.st | 122 +++--- .../TLExpandCollapseNodesActionTest.class.st | 102 ++--- .../TLGradientTest.class.st | 54 +-- .../TLHideActionTest.class.st | 78 ++-- .../TLLegendTest.class.st | 54 +-- .../TLMockVisualization.class.st | 62 +-- src/Telescope-Core-Tests/TLModelTest.class.st | 107 +++-- .../TLNodeCreationStrategyTest.class.st | 128 +++--- .../TLObjectTest.class.st | 78 ++-- .../TLObtainRequestTest.class.st | 364 +++++++++--------- .../TLSimpleNodeTest.class.st | 150 ++++---- .../TLSortingStrategiesTest.class.st | 120 +++--- .../TLStyleSheetTest.class.st | 118 +++--- .../TLTelescopeTest.class.st | 130 +++---- .../TLTestConnector.class.st | 312 +++++++-------- .../TLVisualizationBuilderTest.class.st | 82 ++-- .../TLVisualizationTest.class.st | 78 ++-- .../TLWithTestConnectorTest.class.st | 30 +- src/Telescope-Core-Tests/package.st | 2 +- src/Telescope-Core/TLClientAction.class.st | 3 +- src/Telescope-Core/TLConnector.class.st | 6 + src/Telescope-Core/TLVisualization.class.st | 5 + 33 files changed, 1606 insertions(+), 1611 deletions(-) diff --git a/.github/workflows/continuous.yml b/.github/workflows/continuous.yml index 2a8935f2..81c7032b 100644 --- a/.github/workflows/continuous.yml +++ b/.github/workflows/continuous.yml @@ -17,7 +17,7 @@ jobs: runs-on: ubuntu-latest strategy: matrix: - smalltalk: [ Pharo64-6.1, Pharo64-7.0, Pharo64-8.0, Pharo64-9.0, Pharo64-10 ] + smalltalk: [ Pharo64-6.1, Pharo64-7.0, Pharo64-8.0, Pharo64-9.0 ] name: ${{ matrix.smalltalk }} steps: - uses: actions/checkout@v2 diff --git a/README.md b/README.md index 8827d52e..73ca8bf8 100644 --- a/README.md +++ b/README.md @@ -70,8 +70,8 @@ Examples can be found in the CytoscapeJs connector repository. | Telescope version | Compatible Pharo versions | |------------------- |--------------------------- | | v1.x.x | Pharo 61, 70 | -| v2.x.x | Pharo 61, 70, 80, 90, 10 | -| development | Pharo 61, 70, 80, 90, 10 | +| v2.x.x | Pharo 61, 70, 80, 90 | +| development | Pharo 61, 70, 80, 90 | ## Contact diff --git a/src/Telescope-Core-Tests/ManifestTelescopeCoreTests.class.st b/src/Telescope-Core-Tests/ManifestTelescopeCoreTests.class.st index 33ec076d..569776b9 100644 --- a/src/Telescope-Core-Tests/ManifestTelescopeCoreTests.class.st +++ b/src/Telescope-Core-Tests/ManifestTelescopeCoreTests.class.st @@ -1,8 +1,8 @@ -" -I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser -" -Class { - #name : #ManifestTelescopeCoreTests, - #superclass : #PackageManifest, - #category : #'Telescope-Core-Tests-Manifest' -} +" +I store metadata for this package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser +" +Class { + #name : #ManifestTelescopeCoreTests, + #superclass : #PackageManifest, + #category : #'Telescope-Core-Tests-Manifest' +} diff --git a/src/Telescope-Core-Tests/TLAbstractNodeTest.class.st b/src/Telescope-Core-Tests/TLAbstractNodeTest.class.st index ba47525b..7bf071b1 100644 --- a/src/Telescope-Core-Tests/TLAbstractNodeTest.class.st +++ b/src/Telescope-Core-Tests/TLAbstractNodeTest.class.st @@ -1,28 +1,28 @@ -Class { - #name : #TLAbstractNodeTest, - #superclass : #TestCase, - #instVars : [ - 'node' - ], - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #running } -TLAbstractNodeTest >> setUp [ - super setUp. - node := TLAbstractNode new -] - -{ #category : #tests } -TLAbstractNodeTest >> testNotDuplicateAdjacentNodes [ - | in inOut out adjacents | - in:= TLAbstractNode withEntity: 'in'. - inOut:= TLAbstractNode withEntity: 'inOut'. - out:= TLAbstractNode withEntity: 'out'. - TLConnection from: in to: node visualization: nil. - TLConnection from: inOut to: node visualization: nil. - TLConnection from: node to: inOut visualization: nil. - TLConnection from: node to: out visualization: nil. - adjacents:= node adjacentNodes. - self assert: adjacents size equals: 3 -] +Class { + #name : #TLAbstractNodeTest, + #superclass : #TestCase, + #instVars : [ + 'node' + ], + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #running } +TLAbstractNodeTest >> setUp [ + super setUp. + node := TLAbstractNode new +] + +{ #category : #tests } +TLAbstractNodeTest >> testNotDuplicateAdjacentNodes [ + | in inOut out adjacents | + in:= TLAbstractNode withEntity: 'in'. + inOut:= TLAbstractNode withEntity: 'inOut'. + out:= TLAbstractNode withEntity: 'out'. + TLConnection from: in to: node visualization: nil. + TLConnection from: inOut to: node visualization: nil. + TLConnection from: node to: inOut visualization: nil. + TLConnection from: node to: out visualization: nil. + adjacents:= node adjacentNodes. + self assert: adjacents size equals: 3 +] diff --git a/src/Telescope-Core-Tests/TLCompositeNodeTest.class.st b/src/Telescope-Core-Tests/TLCompositeNodeTest.class.st index a4d537c2..5fdca731 100644 --- a/src/Telescope-Core-Tests/TLCompositeNodeTest.class.st +++ b/src/Telescope-Core-Tests/TLCompositeNodeTest.class.st @@ -1,71 +1,71 @@ -Class { - #name : #TLCompositeNodeTest, - #superclass : #TestCase, - #instVars : [ - 'node' - ], - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #running } -TLCompositeNodeTest >> setUp [ - super setUp. - node := TLCompositeNode new. - node childrenNodeCreationStrategy: TLNodeCreationStrategy default. - -] - -{ #category : #tests } -TLCompositeNodeTest >> testChildrenCreationWithBlock [ - node entity: 42. - node childrenProperty: [ :entity | - self assert: entity equals: 42. - #(1 2 3) ]. - node createChildrenNodes. - self assert: node childrenNodes size equals: 3. - self assert: node childrenNodes first entity equals: 1. - self assert: node childrenNodes second entity equals: 2. - self assert: node childrenNodes third entity equals: 3 -] - -{ #category : #tests } -TLCompositeNodeTest >> testChildrenCreationWithCollectionOfEntities [ - node childrenProperty: #(1 2 3). - node createChildrenNodes. - self assert: node childrenNodes size equals: 3. - self assert: node childrenNodes first entity equals: 1. - self assert: node childrenNodes second entity equals: 2. - self assert: node childrenNodes third entity equals: 3 -] - -{ #category : #tests } -TLCompositeNodeTest >> testChildrenCreationWithProperty [ - node entity: 30. - node childrenProperty: #primeFactors. - node createChildrenNodes. - self assert: node childrenNodes size equals: 3. - self assert: node childrenNodes first entity equals: 2. - self assert: node childrenNodes second entity equals: 3. - self assert: node childrenNodes third entity equals: 5 -] - -{ #category : #tests } -TLCompositeNodeTest >> testMoveChildNodeFromOneParentToAnother [ - | childNode anotherNode | - childNode := node addChildNodeFromEntity: #child. - anotherNode := TLCompositeNode new. - node childrenNodes first parent: anotherNode. - self assert: node childrenNodes isEmpty. - self assert: anotherNode childrenNodes size equals: 1. - self assert: childNode parent equals: anotherNode -] - -{ #category : #tests } -TLCompositeNodeTest >> testMoveChildNodeFromOneParentToTheSame [ - | childNode | - childNode := node addChildNodeFromEntity: #child. - childNode parent: node. - childNode parent: node. - self assert: node childrenNodes size equals: 1. - self assert: childNode parent equals: node -] +Class { + #name : #TLCompositeNodeTest, + #superclass : #TestCase, + #instVars : [ + 'node' + ], + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #running } +TLCompositeNodeTest >> setUp [ + super setUp. + node := TLCompositeNode new. + node childrenNodeCreationStrategy: TLNodeCreationStrategy default. + +] + +{ #category : #tests } +TLCompositeNodeTest >> testChildrenCreationWithBlock [ + node entity: 42. + node childrenProperty: [ :entity | + self assert: entity equals: 42. + #(1 2 3) ]. + node createChildrenNodes. + self assert: node childrenNodes size equals: 3. + self assert: node childrenNodes first entity equals: 1. + self assert: node childrenNodes second entity equals: 2. + self assert: node childrenNodes third entity equals: 3 +] + +{ #category : #tests } +TLCompositeNodeTest >> testChildrenCreationWithCollectionOfEntities [ + node childrenProperty: #(1 2 3). + node createChildrenNodes. + self assert: node childrenNodes size equals: 3. + self assert: node childrenNodes first entity equals: 1. + self assert: node childrenNodes second entity equals: 2. + self assert: node childrenNodes third entity equals: 3 +] + +{ #category : #tests } +TLCompositeNodeTest >> testChildrenCreationWithProperty [ + node entity: 30. + node childrenProperty: #primeFactors. + node createChildrenNodes. + self assert: node childrenNodes size equals: 3. + self assert: node childrenNodes first entity equals: 2. + self assert: node childrenNodes second entity equals: 3. + self assert: node childrenNodes third entity equals: 5 +] + +{ #category : #tests } +TLCompositeNodeTest >> testMoveChildNodeFromOneParentToAnother [ + | childNode anotherNode | + childNode := node addChildNodeFromEntity: #child. + anotherNode := TLCompositeNode new. + node childrenNodes first parent: anotherNode. + self assert: node childrenNodes isEmpty. + self assert: anotherNode childrenNodes size equals: 1. + self assert: childNode parent equals: anotherNode +] + +{ #category : #tests } +TLCompositeNodeTest >> testMoveChildNodeFromOneParentToTheSame [ + | childNode | + childNode := node addChildNodeFromEntity: #child. + childNode parent: node. + childNode parent: node. + self assert: node childrenNodes size equals: 1. + self assert: childNode parent equals: node +] diff --git a/src/Telescope-Core-Tests/TLConnectActionTest.class.st b/src/Telescope-Core-Tests/TLConnectActionTest.class.st index f30b7b25..b4b5f4f2 100644 --- a/src/Telescope-Core-Tests/TLConnectActionTest.class.st +++ b/src/Telescope-Core-Tests/TLConnectActionTest.class.st @@ -1,36 +1,36 @@ -Class { - #name : #TLConnectActionTest, - #superclass : #TestCase, - #category : #'Telescope-Core-Tests-Actions' -} - -{ #category : #tests } -TLConnectActionTest >> testTriggerAction [ - | connectAction sourceNode targetNode | - sourceNode := TLSimpleNode withEntity: 4. - targetNode := TLSimpleNode withEntity: 2. - connectAction := TLConnectAction - property: [ :e | {e sqrt} ] - context: (TLDrawableCollection with: sourceNode with: targetNode). - connectAction actionOn: sourceNode. - self assert: sourceNode outgoingConnections size equals: 1. - self assert: targetNode incomingConnections size equals: 1. - self - assert: sourceNode outgoingConnections anyOne - equals: targetNode incomingConnections anyOne -] - -{ #category : #tests } -TLConnectActionTest >> testTriggerActionTwiceForReversibility [ - "this test is valid only if testTriggerAction is valid" - | connectAction sourceNode targetNode | - sourceNode := TLSimpleNode withEntity: 4. - targetNode := TLSimpleNode withEntity: 2. - connectAction := TLConnectAction - property: [ :e | {e sqrt} ] - context: (TLDrawableCollection with: sourceNode with: targetNode). - connectAction actionOn: sourceNode. - connectAction actionOn: sourceNode. - self assert: sourceNode outgoingConnections isEmpty. - self assert: targetNode incomingConnections isEmpty -] +Class { + #name : #TLConnectActionTest, + #superclass : #TestCase, + #category : #'Telescope-Core-Tests-Actions' +} + +{ #category : #tests } +TLConnectActionTest >> testTriggerAction [ + | connectAction sourceNode targetNode | + sourceNode := TLSimpleNode withEntity: 4. + targetNode := TLSimpleNode withEntity: 2. + connectAction := TLConnectAction + property: [ :e | {e sqrt} ] + context: (TLDrawableCollection with: sourceNode with: targetNode). + connectAction actionOn: sourceNode. + self assert: sourceNode outgoingConnections size equals: 1. + self assert: targetNode incomingConnections size equals: 1. + self + assert: sourceNode outgoingConnections anyOne + equals: targetNode incomingConnections anyOne +] + +{ #category : #tests } +TLConnectActionTest >> testTriggerActionTwiceForReversibility [ + "this test is valid only if testTriggerAction is valid" + | connectAction sourceNode targetNode | + sourceNode := TLSimpleNode withEntity: 4. + targetNode := TLSimpleNode withEntity: 2. + connectAction := TLConnectAction + property: [ :e | {e sqrt} ] + context: (TLDrawableCollection with: sourceNode with: targetNode). + connectAction actionOn: sourceNode. + connectAction actionOn: sourceNode. + self assert: sourceNode outgoingConnections isEmpty. + self assert: targetNode incomingConnections isEmpty +] diff --git a/src/Telescope-Core-Tests/TLConnectWithEntityActionTest.class.st b/src/Telescope-Core-Tests/TLConnectWithEntityActionTest.class.st index 99ab2865..14db05be 100644 --- a/src/Telescope-Core-Tests/TLConnectWithEntityActionTest.class.st +++ b/src/Telescope-Core-Tests/TLConnectWithEntityActionTest.class.st @@ -1,38 +1,38 @@ -Class { - #name : #TLConnectWithEntityActionTest, - #superclass : #TestCase, - #category : #'Telescope-Core-Tests-Actions' -} - -{ #category : #tests } -TLConnectWithEntityActionTest >> testTriggerAction [ - | connectAction sourceNode targetNode | - sourceNode := TLSimpleNode withEntity: 4. - targetNode := TLSimpleNode withEntity: 2. - connectAction := TLConnectWithEntityAction - connectionProperty: [ :e | {e squared} ] - property: [ :connectionEntity | connectionEntity / 8 ] - context: (TLDrawableCollection with: sourceNode with: targetNode). - connectAction actionOn: sourceNode. - self assert: sourceNode outgoingConnections size equals: 1. - self assert: targetNode incomingConnections size equals: 1. - self - assert: sourceNode outgoingConnections anyOne - equals: targetNode incomingConnections anyOne -] - -{ #category : #tests } -TLConnectWithEntityActionTest >> testTriggerActionTwiceForReversibility [ - "this test is valid only if testTriggerAction is valid" - | connectAction sourceNode targetNode | - sourceNode := TLSimpleNode withEntity: 4. - targetNode := TLSimpleNode withEntity: 2. - connectAction := TLConnectWithEntityAction - connectionProperty: [ :e | {e squared} ] - property: [ :connectionEntity | connectionEntity / 8 ] - context: (TLDrawableCollection with: sourceNode with: targetNode). - connectAction actionOn: sourceNode. - connectAction actionOn: sourceNode. - self assert: sourceNode outgoingConnections isEmpty. - self assert: targetNode incomingConnections isEmpty -] +Class { + #name : #TLConnectWithEntityActionTest, + #superclass : #TestCase, + #category : #'Telescope-Core-Tests-Actions' +} + +{ #category : #tests } +TLConnectWithEntityActionTest >> testTriggerAction [ + | connectAction sourceNode targetNode | + sourceNode := TLSimpleNode withEntity: 4. + targetNode := TLSimpleNode withEntity: 2. + connectAction := TLConnectWithEntityAction + connectionProperty: [ :e | {e squared} ] + property: [ :connectionEntity | connectionEntity / 8 ] + context: (TLDrawableCollection with: sourceNode with: targetNode). + connectAction actionOn: sourceNode. + self assert: sourceNode outgoingConnections size equals: 1. + self assert: targetNode incomingConnections size equals: 1. + self + assert: sourceNode outgoingConnections anyOne + equals: targetNode incomingConnections anyOne +] + +{ #category : #tests } +TLConnectWithEntityActionTest >> testTriggerActionTwiceForReversibility [ + "this test is valid only if testTriggerAction is valid" + | connectAction sourceNode targetNode | + sourceNode := TLSimpleNode withEntity: 4. + targetNode := TLSimpleNode withEntity: 2. + connectAction := TLConnectWithEntityAction + connectionProperty: [ :e | {e squared} ] + property: [ :connectionEntity | connectionEntity / 8 ] + context: (TLDrawableCollection with: sourceNode with: targetNode). + connectAction actionOn: sourceNode. + connectAction actionOn: sourceNode. + self assert: sourceNode outgoingConnections isEmpty. + self assert: targetNode incomingConnections isEmpty +] diff --git a/src/Telescope-Core-Tests/TLConnectionsTest.class.st b/src/Telescope-Core-Tests/TLConnectionsTest.class.st index 0d93a5ae..c80ffc2c 100644 --- a/src/Telescope-Core-Tests/TLConnectionsTest.class.st +++ b/src/Telescope-Core-Tests/TLConnectionsTest.class.st @@ -1,127 +1,127 @@ -Class { - #name : #TLConnectionsTest, - #superclass : #TestCase, - #instVars : [ - 'group' - ], - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #running } -TLConnectionsTest >> setUp [ - super setUp. - group := TLEntitiesGroup new. - TLVisualization new addDrawable: group. - group addNodesFromEntities: (1 to: 4) -] - -{ #category : #tests } -TLConnectionsTest >> testConnectGroupFromANode [ - | connections | - connections := group connectFrom: TLSimpleNode new. - self assert: connections size equals: 4. -] - -{ #category : #tests } -TLConnectionsTest >> testConnectGroupToANode [ - | connections | - connections := group connectTo: TLSimpleNode new. - self assert: connections size equals: 4. -] - -{ #category : #tests } -TLConnectionsTest >> testConnectGroupWithSubgroupFromANode [ - | connections | - group > #subgroup addNodesFromEntities: (5 to: 8). - connections := group connectFrom: TLSimpleNode new. - self assert: connections size equals: 8. -] - -{ #category : #tests } -TLConnectionsTest >> testConnectGroupWithSubgroupToANode [ - | connections | - group > #subgroup addNodesFromEntities: (5 to: 8). - connections := group connectTo: TLSimpleNode new. - self assert: connections size equals: 8. -] - -{ #category : #tests } -TLConnectionsTest >> testConnectIfNotNodeToAGroup [ - | connections node | - node := TLSimpleNode new. - connections := node connectIfNotTo: group. - self assert: connections size equals: 4. - self assert: connections asArray equals: (node connectIfNotTo: group) asArray. - self assert: node outgoingConnections size equals: 4 - -] - -{ #category : #tests } -TLConnectionsTest >> testConnectIfNotNodeToAnotherNode [ - | connection nodeA nodeB | - nodeA := TLSimpleNode withEntity: $a. - nodeB := TLSimpleNode withEntity: $b. - connection := nodeA connectIfNotTo: nodeB. - self assert: connection fromNode equals: nodeA. - self assert: connection toNode equals: nodeB. - self assert: connection equals: (nodeA connectIfNotTo: nodeB). - self assert: nodeA outgoingConnections size equals: 1 -] - -{ #category : #tests } -TLConnectionsTest >> testConnectNodeFromAGroup [ - | connections | - connections := TLSimpleNode new connectFrom: group. - self assert: connections size equals: 4. -] - -{ #category : #tests } -TLConnectionsTest >> testConnectNodeFromAnotherNode [ - | connection nodeA nodeB | - nodeA := TLSimpleNode withEntity: $a. - nodeB := TLSimpleNode withEntity: $b. - connection := nodeB connectFrom: nodeA. - self assert: connection fromNode equals: nodeA. - self assert: connection toNode equals: nodeB. - -] - -{ #category : #tests } -TLConnectionsTest >> testConnectNodeToAGroup [ - | connections | - connections := TLSimpleNode new connectTo: group. - self assert: connections size equals: 4. -] - -{ #category : #tests } -TLConnectionsTest >> testConnectNodeToAnotherNode [ - | connection nodeA nodeB | - nodeA := TLSimpleNode withEntity: $a. - nodeB := TLSimpleNode withEntity: $b. - connection := nodeA connectTo: nodeB. - self assert: connection fromNode equals: nodeA. - self assert: connection toNode equals: nodeB. - -] - -{ #category : #tests } -TLConnectionsTest >> testConnectThroughWithCollection [ - | connections connection | - connections := group connectThrough: [ :each | {each + 1} ] to: [ :each | each + 2 ]. - self assert: connections size equals: 1. - connection := connections first. - self assert: connection fromNode entity equals: 1. - self assert: connection toNode entity equals: 4. - self assert: connection entity equals: 2. -] - -{ #category : #tests } -TLConnectionsTest >> testConnectThroughWithNonExistingEntity [ - | connections connection | - connections := group connectThrough: [ :each | {each + 1 . each + 16} ] to: [ :each | each + 2 ]. - self assert: connections size equals: 1. - connection := connections first. - self assert: connection fromNode entity equals: 1. - self assert: connection toNode entity equals: 4. - self assert: connection entity equals: 2. -] +Class { + #name : #TLConnectionsTest, + #superclass : #TestCase, + #instVars : [ + 'group' + ], + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #running } +TLConnectionsTest >> setUp [ + super setUp. + group := TLEntitiesGroup new. + TLVisualization new addDrawable: group. + group addNodesFromEntities: (1 to: 4) +] + +{ #category : #tests } +TLConnectionsTest >> testConnectGroupFromANode [ + | connections | + connections := group connectFrom: TLSimpleNode new. + self assert: connections size equals: 4. +] + +{ #category : #tests } +TLConnectionsTest >> testConnectGroupToANode [ + | connections | + connections := group connectTo: TLSimpleNode new. + self assert: connections size equals: 4. +] + +{ #category : #tests } +TLConnectionsTest >> testConnectGroupWithSubgroupFromANode [ + | connections | + group > #subgroup addNodesFromEntities: (5 to: 8). + connections := group connectFrom: TLSimpleNode new. + self assert: connections size equals: 8. +] + +{ #category : #tests } +TLConnectionsTest >> testConnectGroupWithSubgroupToANode [ + | connections | + group > #subgroup addNodesFromEntities: (5 to: 8). + connections := group connectTo: TLSimpleNode new. + self assert: connections size equals: 8. +] + +{ #category : #tests } +TLConnectionsTest >> testConnectIfNotNodeToAGroup [ + | connections node | + node := TLSimpleNode new. + connections := node connectIfNotTo: group. + self assert: connections size equals: 4. + self assert: connections asArray equals: (node connectIfNotTo: group) asArray. + self assert: node outgoingConnections size equals: 4 + +] + +{ #category : #tests } +TLConnectionsTest >> testConnectIfNotNodeToAnotherNode [ + | connection nodeA nodeB | + nodeA := TLSimpleNode withEntity: $a. + nodeB := TLSimpleNode withEntity: $b. + connection := nodeA connectIfNotTo: nodeB. + self assert: connection fromNode equals: nodeA. + self assert: connection toNode equals: nodeB. + self assert: connection equals: (nodeA connectIfNotTo: nodeB). + self assert: nodeA outgoingConnections size equals: 1 +] + +{ #category : #tests } +TLConnectionsTest >> testConnectNodeFromAGroup [ + | connections | + connections := TLSimpleNode new connectFrom: group. + self assert: connections size equals: 4. +] + +{ #category : #tests } +TLConnectionsTest >> testConnectNodeFromAnotherNode [ + | connection nodeA nodeB | + nodeA := TLSimpleNode withEntity: $a. + nodeB := TLSimpleNode withEntity: $b. + connection := nodeB connectFrom: nodeA. + self assert: connection fromNode equals: nodeA. + self assert: connection toNode equals: nodeB. + +] + +{ #category : #tests } +TLConnectionsTest >> testConnectNodeToAGroup [ + | connections | + connections := TLSimpleNode new connectTo: group. + self assert: connections size equals: 4. +] + +{ #category : #tests } +TLConnectionsTest >> testConnectNodeToAnotherNode [ + | connection nodeA nodeB | + nodeA := TLSimpleNode withEntity: $a. + nodeB := TLSimpleNode withEntity: $b. + connection := nodeA connectTo: nodeB. + self assert: connection fromNode equals: nodeA. + self assert: connection toNode equals: nodeB. + +] + +{ #category : #tests } +TLConnectionsTest >> testConnectThroughWithCollection [ + | connections connection | + connections := group connectThrough: [ :each | {each + 1} ] to: [ :each | each + 2 ]. + self assert: connections size equals: 1. + connection := connections first. + self assert: connection fromNode entity equals: 1. + self assert: connection toNode entity equals: 4. + self assert: connection entity equals: 2. +] + +{ #category : #tests } +TLConnectionsTest >> testConnectThroughWithNonExistingEntity [ + | connections connection | + connections := group connectThrough: [ :each | {each + 1 . each + 16} ] to: [ :each | each + 2 ]. + self assert: connections size equals: 1. + connection := connections first. + self assert: connection fromNode entity equals: 1. + self assert: connection toNode entity equals: 4. + self assert: connection entity equals: 2. +] diff --git a/src/Telescope-Core-Tests/TLConnectionsWithEntityTest.class.st b/src/Telescope-Core-Tests/TLConnectionsWithEntityTest.class.st index ceb07273..49a7fe2c 100644 --- a/src/Telescope-Core-Tests/TLConnectionsWithEntityTest.class.st +++ b/src/Telescope-Core-Tests/TLConnectionsWithEntityTest.class.st @@ -1,83 +1,83 @@ -Class { - #name : #TLConnectionsWithEntityTest, - #superclass : #TestCase, - #instVars : [ - 'group' - ], - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #running } -TLConnectionsWithEntityTest >> setUp [ - super setUp. - group := TLEntitiesGroup new. - TLVisualization new addDrawable: group. - group addNodesFromEntities: (1 to: 4) -] - -{ #category : #tests } -TLConnectionsWithEntityTest >> testConnectGroupFromANode [ - | connections | - connections := group connectFrom: TLSimpleNode new entity: 42. - self assert: connections size equals: 4. - -] - -{ #category : #tests } -TLConnectionsWithEntityTest >> testConnectGroupToANode [ - | connections | - connections := group connectTo: TLSimpleNode new entity: 42. - self assert: connections size equals: 4 -] - -{ #category : #tests } -TLConnectionsWithEntityTest >> testConnectGroupWithSubgroupFromANode [ - | connections | - group > #subgroup addNodesFromEntities: (5 to: 8). - connections := group connectFrom: TLSimpleNode new entity: 42.. - self assert: connections size equals: 8. -] - -{ #category : #tests } -TLConnectionsWithEntityTest >> testConnectGroupWithSubgroupToANode [ - | connections | - group > #subgroup addNodesFromEntities: (5 to: 8). - connections := group connectTo: TLSimpleNode new entity: 42.. - self assert: connections size equals: 8. -] - -{ #category : #tests } -TLConnectionsWithEntityTest >> testConnectNodeFromAGroup [ - | connections | - connections := TLSimpleNode new connectFrom: group entity: 42.. - self assert: connections size equals: 4. -] - -{ #category : #tests } -TLConnectionsWithEntityTest >> testConnectNodeFromAnotherNode [ - | connection nodeA nodeB | - nodeA := TLSimpleNode withEntity: $a. - nodeB := TLSimpleNode withEntity: $b. - connection := nodeB connectFrom: nodeA entity: 42. - self assert: connection fromNode equals: nodeA. - self assert: connection toNode equals: nodeB. - -] - -{ #category : #tests } -TLConnectionsWithEntityTest >> testConnectNodeToAGroup [ - | connections | - connections := TLSimpleNode new connectTo: group entity: 42. - self assert: connections size equals: 4. -] - -{ #category : #tests } -TLConnectionsWithEntityTest >> testConnectNodeToAnotherNode [ - | connection nodeA nodeB | - nodeA := TLSimpleNode withEntity: $a. - nodeB := TLSimpleNode withEntity: $b. - connection := nodeA connectTo: nodeB entity: 42. - self assert: connection fromNode equals: nodeA. - self assert: connection toNode equals: nodeB. - -] +Class { + #name : #TLConnectionsWithEntityTest, + #superclass : #TestCase, + #instVars : [ + 'group' + ], + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #running } +TLConnectionsWithEntityTest >> setUp [ + super setUp. + group := TLEntitiesGroup new. + TLVisualization new addDrawable: group. + group addNodesFromEntities: (1 to: 4) +] + +{ #category : #tests } +TLConnectionsWithEntityTest >> testConnectGroupFromANode [ + | connections | + connections := group connectFrom: TLSimpleNode new entity: 42. + self assert: connections size equals: 4. + +] + +{ #category : #tests } +TLConnectionsWithEntityTest >> testConnectGroupToANode [ + | connections | + connections := group connectTo: TLSimpleNode new entity: 42. + self assert: connections size equals: 4 +] + +{ #category : #tests } +TLConnectionsWithEntityTest >> testConnectGroupWithSubgroupFromANode [ + | connections | + group > #subgroup addNodesFromEntities: (5 to: 8). + connections := group connectFrom: TLSimpleNode new entity: 42.. + self assert: connections size equals: 8. +] + +{ #category : #tests } +TLConnectionsWithEntityTest >> testConnectGroupWithSubgroupToANode [ + | connections | + group > #subgroup addNodesFromEntities: (5 to: 8). + connections := group connectTo: TLSimpleNode new entity: 42.. + self assert: connections size equals: 8. +] + +{ #category : #tests } +TLConnectionsWithEntityTest >> testConnectNodeFromAGroup [ + | connections | + connections := TLSimpleNode new connectFrom: group entity: 42.. + self assert: connections size equals: 4. +] + +{ #category : #tests } +TLConnectionsWithEntityTest >> testConnectNodeFromAnotherNode [ + | connection nodeA nodeB | + nodeA := TLSimpleNode withEntity: $a. + nodeB := TLSimpleNode withEntity: $b. + connection := nodeB connectFrom: nodeA entity: 42. + self assert: connection fromNode equals: nodeA. + self assert: connection toNode equals: nodeB. + +] + +{ #category : #tests } +TLConnectionsWithEntityTest >> testConnectNodeToAGroup [ + | connections | + connections := TLSimpleNode new connectTo: group entity: 42. + self assert: connections size equals: 4. +] + +{ #category : #tests } +TLConnectionsWithEntityTest >> testConnectNodeToAnotherNode [ + | connection nodeA nodeB | + nodeA := TLSimpleNode withEntity: $a. + nodeB := TLSimpleNode withEntity: $b. + connection := nodeA connectTo: nodeB entity: 42. + self assert: connection fromNode equals: nodeA. + self assert: connection toNode equals: nodeB. + +] diff --git a/src/Telescope-Core-Tests/TLConnectorTest.class.st b/src/Telescope-Core-Tests/TLConnectorTest.class.st index 5951935d..47a9688d 100644 --- a/src/Telescope-Core-Tests/TLConnectorTest.class.st +++ b/src/Telescope-Core-Tests/TLConnectorTest.class.st @@ -1,85 +1,85 @@ -Class { - #name : #TLConnectorTest, - #superclass : #TestCase, - #instVars : [ - 'connector' - ], - #category : #'Telescope-Core-Tests-Connector' -} - -{ #category : #running } -TLConnectorTest >> setUp [ - super setUp. - connector := TLTestConnector new -] - -{ #category : #tests } -TLConnectorTest >> testCompositeUpdatingChildNode [ - | group composite | - group := TLEntitiesGroup new. - group styleSheet expandCompositeNodes. - group generator: connector. - composite := group addCompositeNodeFromEntity: #parent children: #(child1). - group generate. - self assert: connector shapeByDrawable size equals: 4. - "group + composite + composite children group + child1" - composite childrenNodes first requireUpdate. - self assert: composite isUpdateRequired. - group update. - self deny: composite isUpdateRequired. - self assert: connector shapeByDrawable size equals: 4. - -] - -{ #category : #tests } -TLConnectorTest >> testGroupUpdatingAddElement [ - | group cNode aNode bNode | - group := TLEntitiesGroup new. - group generator: connector. - group nodeCreationStrategy: TLNodeCreationStrategy default; layout: nil. - aNode := group addNodeFromEntity: $a. - bNode := group addNodeFromEntity: $b. - group generate. - cNode := group addNodeFromEntity: $c. - group update. - self assert: (connector elementFromTLDrawable: group) equals: {aNode -> #element . bNode -> #element . cNode -> #element } asOrderedCollection -] - -{ #category : #tests } -TLConnectorTest >> testGroupUpdatingKeepOrder [ - | group cNode aNode bNode | - group := TLEntitiesGroup new. - group generator: connector. - group nodeCreationStrategy: TLNodeCreationStrategy default; layout: nil. - aNode := group addNodeFromEntity: $a. - bNode := group addNodeFromEntity: $b. - cNode := group addNodeFromEntity: $c. - group generate. - group moveToFirstPosition: cNode. - group update. - self assert: (connector elementFromTLDrawable: group) equals: {cNode -> #element . aNode -> #element . bNode -> #element } asOrderedCollection -] - -{ #category : #tests } -TLConnectorTest >> testNodeWithShapeInteractionCorrectlyGenerated [ - | node interaction | - node := TLSimpleNode new. - interaction := ((TLCustomAction block: [ :aTLDrawable | ]) withTriggerStyle: #aStyle) onClick. - node addInteraction: interaction. - node generateWith: connector. - self assert: connector view size equals: 2. "the node and the trigger" - self assert: ((connector interactionsByDrawable at: node) includes: interaction). -] - -{ #category : #tests } -TLConnectorTest >> testNodeWithShapeInteractionCorrectlyRemoved [ - | node interaction | - node := TLSimpleNode new. - interaction := (TLCustomAction block: [ :aTLDrawable | ]) withTriggerStyle: #aStyle. - node addInteraction: interaction. - node generateWith: connector. - self assert: connector view size equals: 2. "the node and the trigger" - node removeWith: connector. - self assert: connector view isEmpty - -] +Class { + #name : #TLConnectorTest, + #superclass : #TestCase, + #instVars : [ + 'connector' + ], + #category : #'Telescope-Core-Tests-Connector' +} + +{ #category : #running } +TLConnectorTest >> setUp [ + super setUp. + connector := TLTestConnector new +] + +{ #category : #tests } +TLConnectorTest >> testCompositeUpdatingChildNode [ + | group composite | + group := TLEntitiesGroup new. + group styleSheet expandCompositeNodes. + group generator: connector. + composite := group addCompositeNodeFromEntity: #parent children: #(child1). + group generate. + self assert: connector shapeByDrawable size equals: 4. + "group + composite + composite children group + child1" + composite childrenNodes first requireUpdate. + self assert: composite isUpdateRequired. + group update. + self deny: composite isUpdateRequired. + self assert: connector shapeByDrawable size equals: 4. + +] + +{ #category : #tests } +TLConnectorTest >> testGroupUpdatingAddElement [ + | group cNode aNode bNode | + group := TLEntitiesGroup new. + group generator: connector. + group nodeCreationStrategy: TLNodeCreationStrategy default; layout: nil. + aNode := group addNodeFromEntity: $a. + bNode := group addNodeFromEntity: $b. + group generate. + cNode := group addNodeFromEntity: $c. + group update. + self assert: (connector elementFromTLDrawable: group) equals: {aNode -> #element . bNode -> #element . cNode -> #element } asOrderedCollection +] + +{ #category : #tests } +TLConnectorTest >> testGroupUpdatingKeepOrder [ + | group cNode aNode bNode | + group := TLEntitiesGroup new. + group generator: connector. + group nodeCreationStrategy: TLNodeCreationStrategy default; layout: nil. + aNode := group addNodeFromEntity: $a. + bNode := group addNodeFromEntity: $b. + cNode := group addNodeFromEntity: $c. + group generate. + group moveToFirstPosition: cNode. + group update. + self assert: (connector elementFromTLDrawable: group) equals: {cNode -> #element . aNode -> #element . bNode -> #element } asOrderedCollection +] + +{ #category : #tests } +TLConnectorTest >> testNodeWithShapeInteractionCorrectlyGenerated [ + | node interaction | + node := TLSimpleNode new. + interaction := ((TLCustomAction block: [ :aTLDrawable | ]) withTriggerStyle: #aStyle) onClick. + node addInteraction: interaction. + node generateWith: connector. + self assert: connector view size equals: 2. "the node and the trigger" + self assert: ((connector interactionsByDrawable at: node) includes: interaction). +] + +{ #category : #tests } +TLConnectorTest >> testNodeWithShapeInteractionCorrectlyRemoved [ + | node interaction | + node := TLSimpleNode new. + interaction := (TLCustomAction block: [ :aTLDrawable | ]) withTriggerStyle: #aStyle. + node addInteraction: interaction. + node generateWith: connector. + self assert: connector view size equals: 2. "the node and the trigger" + node removeWith: connector. + self assert: connector view isEmpty + +] diff --git a/src/Telescope-Core-Tests/TLDrawableTest.class.st b/src/Telescope-Core-Tests/TLDrawableTest.class.st index 887f8cd8..382ec456 100644 --- a/src/Telescope-Core-Tests/TLDrawableTest.class.st +++ b/src/Telescope-Core-Tests/TLDrawableTest.class.st @@ -1,37 +1,37 @@ -Class { - #name : #TLDrawableTest, - #superclass : #TestCase, - #instVars : [ - 'drawable' - ], - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #running } -TLDrawableTest >> setUp [ - super setUp. - drawable := TLDrawable new -] - -{ #category : #tests } -TLDrawableTest >> testAddStyleRequireUpdate [ - self deny: drawable isUpdateRequired. - drawable addStyle: #style. - self assert: drawable isUpdateRequired -] - -{ #category : #tests } -TLDrawableTest >> testremoveNonExistingStyleDoesNotRequireUpdate [ - self deny: drawable isUpdateRequired. - drawable removeStyle: #style. - self deny: drawable isUpdateRequired -] - -{ #category : #tests } -TLDrawableTest >> testremoveStyleRequireUpdateIfPresent [ - self deny: drawable isUpdateRequired. - drawable addStyle: #style. - drawable isUpdateRequired: false. - drawable removeStyle: #style. - self assert: drawable isUpdateRequired -] +Class { + #name : #TLDrawableTest, + #superclass : #TestCase, + #instVars : [ + 'drawable' + ], + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #running } +TLDrawableTest >> setUp [ + super setUp. + drawable := TLDrawable new +] + +{ #category : #tests } +TLDrawableTest >> testAddStyleRequireUpdate [ + self deny: drawable isUpdateRequired. + drawable addStyle: #style. + self assert: drawable isUpdateRequired +] + +{ #category : #tests } +TLDrawableTest >> testremoveNonExistingStyleDoesNotRequireUpdate [ + self deny: drawable isUpdateRequired. + drawable removeStyle: #style. + self deny: drawable isUpdateRequired +] + +{ #category : #tests } +TLDrawableTest >> testremoveStyleRequireUpdateIfPresent [ + self deny: drawable isUpdateRequired. + drawable addStyle: #style. + drawable isUpdateRequired: false. + drawable removeStyle: #style. + self assert: drawable isUpdateRequired +] diff --git a/src/Telescope-Core-Tests/TLEntitiesGroupTest.class.st b/src/Telescope-Core-Tests/TLEntitiesGroupTest.class.st index 960c6752..c89bc3da 100644 --- a/src/Telescope-Core-Tests/TLEntitiesGroupTest.class.st +++ b/src/Telescope-Core-Tests/TLEntitiesGroupTest.class.st @@ -1,61 +1,61 @@ -Class { - #name : #TLEntitiesGroupTest, - #superclass : #TestCase, - #instVars : [ - 'tlGroup', - 'parentMock' - ], - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #running } -TLEntitiesGroupTest >> setUp [ - | generatorMock| - super setUp. - parentMock := Mock named: 'parent'. - generatorMock := Mock named: 'generator'. - - parentMock stub generator willReturn: generatorMock. - parentMock stub effectiveStyleSheet willReturn: TLStyleSheet default. - - tlGroup := TLEntitiesGroup new. - tlGroup nodeCreationStrategy: TLNodeCreationStrategy default. - tlGroup parent: parentMock -] - -{ #category : #running } -TLEntitiesGroupTest >> tearDown [ - parentMock should receive hierarchyHasChanged once. - super tearDown -] - -{ #category : #tests } -TLEntitiesGroupTest >> testAddNodeFromEntity [ - | entityMock node | - entityMock := Mock named: 'entity'. - node := tlGroup addNodeFromEntity: entityMock. - self assert: node class equals: TLSimpleNode. - self assert: tlGroup size equals: 1 -] - -{ #category : #tests } -TLEntitiesGroupTest >> testAllNodesDo [ - | node1 node2 node3 | - node1 := Mock named: 'node1'. - node2 := Mock named: 'node2'. - node3 := Mock named: 'node3'. - {node1 . node2 . node3} do: [ :node | node stub isNode willReturn: true ]. - tlGroup > #subGroup addChild: node1. - tlGroup addChild: node2. - tlGroup > #subGroup > #subSubGroup addChild: node3. - tlGroup allNodesDo: [ :aNode | aNode testMessage ]. - {node1 . node2 . node3} do: [ :node | node should receive testMessage once ] -] - -{ #category : #tests } -TLEntitiesGroupTest >> testCreateASubGroup [ - self assert: tlGroup telescopeEntities isEmpty. - self assert: (tlGroup > #subGroup) isEmpty. - self assert: tlGroup telescopeEntities size equals: 1. - self assert: tlGroup telescopeEntities first isGroup -] +Class { + #name : #TLEntitiesGroupTest, + #superclass : #TestCase, + #instVars : [ + 'tlGroup', + 'parentMock' + ], + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #running } +TLEntitiesGroupTest >> setUp [ + | generatorMock| + super setUp. + parentMock := Mock named: 'parent'. + generatorMock := Mock named: 'generator'. + + parentMock stub generator willReturn: generatorMock. + parentMock stub effectiveStyleSheet willReturn: TLStyleSheet default. + + tlGroup := TLEntitiesGroup new. + tlGroup nodeCreationStrategy: TLNodeCreationStrategy default. + tlGroup parent: parentMock +] + +{ #category : #running } +TLEntitiesGroupTest >> tearDown [ + parentMock should receive hierarchyHasChanged once. + super tearDown +] + +{ #category : #tests } +TLEntitiesGroupTest >> testAddNodeFromEntity [ + | entityMock node | + entityMock := Mock named: 'entity'. + node := tlGroup addNodeFromEntity: entityMock. + self assert: node class equals: TLSimpleNode. + self assert: tlGroup size equals: 1 +] + +{ #category : #tests } +TLEntitiesGroupTest >> testAllNodesDo [ + | node1 node2 node3 | + node1 := Mock named: 'node1'. + node2 := Mock named: 'node2'. + node3 := Mock named: 'node3'. + {node1 . node2 . node3} do: [ :node | node stub isNode willReturn: true ]. + tlGroup > #subGroup addChild: node1. + tlGroup addChild: node2. + tlGroup > #subGroup > #subSubGroup addChild: node3. + tlGroup allNodesDo: [ :aNode | aNode testMessage ]. + {node1 . node2 . node3} do: [ :node | node should receive testMessage once ] +] + +{ #category : #tests } +TLEntitiesGroupTest >> testCreateASubGroup [ + self assert: tlGroup telescopeEntities isEmpty. + self assert: (tlGroup > #subGroup) isEmpty. + self assert: tlGroup telescopeEntities size equals: 1. + self assert: tlGroup telescopeEntities first isGroup +] diff --git a/src/Telescope-Core-Tests/TLExpandCollapseNodesActionTest.class.st b/src/Telescope-Core-Tests/TLExpandCollapseNodesActionTest.class.st index 8b73bbfb..868c44b4 100644 --- a/src/Telescope-Core-Tests/TLExpandCollapseNodesActionTest.class.st +++ b/src/Telescope-Core-Tests/TLExpandCollapseNodesActionTest.class.st @@ -1,51 +1,51 @@ -Class { - #name : #TLExpandCollapseNodesActionTest, - #superclass : #TestCase, - #instVars : [ - 'visu' - ], - #category : #'Telescope-Core-Tests-Actions' -} - -{ #category : #running } -TLExpandCollapseNodesActionTest >> setUp [ - super setUp. - visu := TLVisualization new - generator: TLTestConnector new; - yourself -] - -{ #category : #tests } -TLExpandCollapseNodesActionTest >> testDefaultCollapse [ - | node action | - node := visu addNodeFromEntity: 4. - visu generate. - action:=(TLExpandCollapseNodesAction property: [ :n | 1 to: n - 1 ]). - action actionOn: node. - self assert: visu nodes size equals: 4. - action actionOn: node. - self assert: visu nodes size equals: 1. - self assert: visu nodes first equals: node. -] - -{ #category : #tests } -TLExpandCollapseNodesActionTest >> testDefaultExpand [ - | node | - node := visu addNodeFromEntity: 4. - visu generate. - (TLExpandCollapseNodesAction property: [ :n | 1 to: n - 1 ]) actionOn: node. - self assert: visu nodes size equals: 4. - -] - -{ #category : #tests } -TLExpandCollapseNodesActionTest >> testExpandInAnotherGroup [ - | node | - node := visu addNodeFromEntity: 4. - visu generate. - (TLExpandCollapseNodesAction property: [ :n | 1 to: n - 1 ] destinationGroup: visu > #childGroup) actionOn: node. - self assert: visu nodes asArray equals: {node}. - self assert: (visu > #childGroup) size equals: 3. - self assert: node outgoingConnections size equals: 3. - self assert: (node outgoingConnections collect: #toNode) equals: (visu > #childGroup) telescopeEntities -] +Class { + #name : #TLExpandCollapseNodesActionTest, + #superclass : #TestCase, + #instVars : [ + 'visu' + ], + #category : #'Telescope-Core-Tests-Actions' +} + +{ #category : #running } +TLExpandCollapseNodesActionTest >> setUp [ + super setUp. + visu := TLVisualization new + generator: TLTestConnector new; + yourself +] + +{ #category : #tests } +TLExpandCollapseNodesActionTest >> testDefaultCollapse [ + | node action | + node := visu addNodeFromEntity: 4. + visu generate. + action:=(TLExpandCollapseNodesAction property: [ :n | 1 to: n - 1 ]). + action actionOn: node. + self assert: visu nodes size equals: 4. + action actionOn: node. + self assert: visu nodes size equals: 1. + self assert: visu nodes first equals: node. +] + +{ #category : #tests } +TLExpandCollapseNodesActionTest >> testDefaultExpand [ + | node | + node := visu addNodeFromEntity: 4. + visu generate. + (TLExpandCollapseNodesAction property: [ :n | 1 to: n - 1 ]) actionOn: node. + self assert: visu nodes size equals: 4. + +] + +{ #category : #tests } +TLExpandCollapseNodesActionTest >> testExpandInAnotherGroup [ + | node | + node := visu addNodeFromEntity: 4. + visu generate. + (TLExpandCollapseNodesAction property: [ :n | 1 to: n - 1 ] destinationGroup: visu > #childGroup) actionOn: node. + self assert: visu nodes asArray equals: {node}. + self assert: (visu > #childGroup) size equals: 3. + self assert: node outgoingConnections size equals: 3. + self assert: (node outgoingConnections collect: #toNode) equals: (visu > #childGroup) telescopeEntities +] diff --git a/src/Telescope-Core-Tests/TLGradientTest.class.st b/src/Telescope-Core-Tests/TLGradientTest.class.st index 6eb882a3..37f4cd03 100644 --- a/src/Telescope-Core-Tests/TLGradientTest.class.st +++ b/src/Telescope-Core-Tests/TLGradientTest.class.st @@ -1,27 +1,27 @@ -Class { - #name : #TLGradientTest, - #superclass : #TestCase, - #instVars : [ - 'gradient' - ], - #category : #'Telescope-Core-Tests-Style' -} - -{ #category : #running } -TLGradientTest >> setUp [ - super setUp. - gradient:= TLGradient new levelProperty: #yourself. -] - -{ #category : #tests } -TLGradientTest >> testRatioForLevel [ - gradient to: Color red at: 5. - gradient to: Color green at: 15. - self assert: (gradient value: 2) equals: Color red. - self assert: (gradient value: 5) equals: Color red. - self assert: (gradient value: 7.5) equals: (Color red alphaMixed: 0.75 with: Color green ). - self assert: (gradient value: 10) equals: (Color red alphaMixed: 0.5 with: Color green ). - self assert: (gradient value: 12.5) equals: (Color red alphaMixed: 0.25 with: Color green ). - self assert: (gradient value: 15) equals: Color green. - self assert: (gradient value: 17) equals: Color green -] +Class { + #name : #TLGradientTest, + #superclass : #TestCase, + #instVars : [ + 'gradient' + ], + #category : #'Telescope-Core-Tests-Style' +} + +{ #category : #running } +TLGradientTest >> setUp [ + super setUp. + gradient:= TLGradient new levelProperty: #yourself. +] + +{ #category : #tests } +TLGradientTest >> testRatioForLevel [ + gradient to: Color red at: 5. + gradient to: Color green at: 15. + self assert: (gradient value: 2) equals: Color red. + self assert: (gradient value: 5) equals: Color red. + self assert: (gradient value: 7.5) equals: (Color red alphaMixed: 0.75 with: Color green ). + self assert: (gradient value: 10) equals: (Color red alphaMixed: 0.5 with: Color green ). + self assert: (gradient value: 12.5) equals: (Color red alphaMixed: 0.25 with: Color green ). + self assert: (gradient value: 15) equals: Color green. + self assert: (gradient value: 17) equals: Color green +] diff --git a/src/Telescope-Core-Tests/TLHideActionTest.class.st b/src/Telescope-Core-Tests/TLHideActionTest.class.st index d035cc99..271eb49d 100644 --- a/src/Telescope-Core-Tests/TLHideActionTest.class.st +++ b/src/Telescope-Core-Tests/TLHideActionTest.class.st @@ -1,39 +1,39 @@ -Class { - #name : #TLHideActionTest, - #superclass : #TestCase, - #category : #'Telescope-Core-Tests-Actions' -} - -{ #category : #tests } -TLHideActionTest >> testHideBlock [ - | node hideAction secondNode connection | - node := TLSimpleNode new. - secondNode := TLSimpleNode new. - connection := node connectTo: secondNode. - hideAction := TLHideAction hide: [ :aNode | aNode allConnections ]. - self assert: connection isVisible. - hideAction actionOn: node. - self deny: connection isVisible -] - -{ #category : #tests } -TLHideActionTest >> testHideNode [ - | node hideAction | - node := TLSimpleNode new. - hideAction := TLHideAction hide: node. - self assert: node isVisible. - hideAction actionOn: node. - self deny: node isVisible -] - -{ #category : #tests } -TLHideActionTest >> testHideSymbol [ - | node hideAction secondNode connection | - node := TLSimpleNode new. - secondNode := TLSimpleNode new. - connection := node connectTo: secondNode. - hideAction := TLHideAction hide: #allConnections. - self assert: connection isVisible. - hideAction actionOn: node. - self deny: connection isVisible -] +Class { + #name : #TLHideActionTest, + #superclass : #TestCase, + #category : #'Telescope-Core-Tests-Actions' +} + +{ #category : #tests } +TLHideActionTest >> testHideBlock [ + | node hideAction secondNode connection | + node := TLSimpleNode new. + secondNode := TLSimpleNode new. + connection := node connectTo: secondNode. + hideAction := TLHideAction hide: [ :aNode | aNode allConnections ]. + self assert: connection isVisible. + hideAction actionOn: node. + self deny: connection isVisible +] + +{ #category : #tests } +TLHideActionTest >> testHideNode [ + | node hideAction | + node := TLSimpleNode new. + hideAction := TLHideAction hide: node. + self assert: node isVisible. + hideAction actionOn: node. + self deny: node isVisible +] + +{ #category : #tests } +TLHideActionTest >> testHideSymbol [ + | node hideAction secondNode connection | + node := TLSimpleNode new. + secondNode := TLSimpleNode new. + connection := node connectTo: secondNode. + hideAction := TLHideAction hide: #allConnections. + self assert: connection isVisible. + hideAction actionOn: node. + self deny: connection isVisible +] diff --git a/src/Telescope-Core-Tests/TLLegendTest.class.st b/src/Telescope-Core-Tests/TLLegendTest.class.st index fefe58f6..277a6541 100644 --- a/src/Telescope-Core-Tests/TLLegendTest.class.st +++ b/src/Telescope-Core-Tests/TLLegendTest.class.st @@ -1,27 +1,27 @@ -Class { - #name : #TLLegendTest, - #superclass : #TestCase, - #instVars : [ - 'legend' - ], - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #tests } -TLLegendTest >> testAlphabeticalSortingOfLegend [ - legend := TLDynamicLegendEntry - description: #yourself - context: (#(#guillaume #yann #cyril #usman) - collect: [ :aName | TLSimpleNode withEntity: aName ]). - - self assert: legend obtainAssociations keys equals: #(#cyril #guillaume #usman #yann) -] - -{ #category : #tests } -TLLegendTest >> testObtainAssociationsUseDescriptionValuable [ - legend := TLDynamicLegendEntry - description: #capitalized - context: (#(#guillaume #yann #cyril #usman) collect: [ :aName | TLSimpleNode withEntity: aName ]). - - self assert: legend obtainAssociations keys equals: #(#Cyril #Guillaume #Usman #Yann) -] +Class { + #name : #TLLegendTest, + #superclass : #TestCase, + #instVars : [ + 'legend' + ], + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #tests } +TLLegendTest >> testAlphabeticalSortingOfLegend [ + legend := TLDynamicLegendEntry + description: #yourself + context: (#(#guillaume #yann #cyril #usman) + collect: [ :aName | TLSimpleNode withEntity: aName ]). + + self assert: legend obtainAssociations keys equals: #(#cyril #guillaume #usman #yann) +] + +{ #category : #tests } +TLLegendTest >> testObtainAssociationsUseDescriptionValuable [ + legend := TLDynamicLegendEntry + description: #capitalized + context: (#(#guillaume #yann #cyril #usman) collect: [ :aName | TLSimpleNode withEntity: aName ]). + + self assert: legend obtainAssociations keys equals: #(#Cyril #Guillaume #Usman #Yann) +] diff --git a/src/Telescope-Core-Tests/TLMockVisualization.class.st b/src/Telescope-Core-Tests/TLMockVisualization.class.st index d9ea7cfb..4a1a9d76 100644 --- a/src/Telescope-Core-Tests/TLMockVisualization.class.st +++ b/src/Telescope-Core-Tests/TLMockVisualization.class.st @@ -1,31 +1,31 @@ -" -Creates a mock visualization for tests. -" -Class { - #name : #TLMockVisualization, - #superclass : #Object, - #category : #'Telescope-Core-Tests-Utils' -} - -{ #category : #'as yet unclassified' } -TLMockVisualization class >> create [ - ^ self new createVisu -] - -{ #category : #building } -TLMockVisualization >> createVisu [ - | visu | - visu := TLVisualization new. - visu nodeCreationStrategy compositeProperty: (1 to: 10) asOrderedCollection. - visu styleSheet - childrenLayout: TLLinearLayout topToBottom; - shape: TLEllipse; - nodeLabel: #mooseName; - backgroundColor: Color gray. - visu styleSheet > #children backgroundColor: Color yellow. - visu - addInteraction: TLPopUpAction onMouseOver; - addInteraction: (TLInspectAction withMenu: 'Inspect'). - visu addNodeFromEntity: 42. - ^ visu -] +" +Creates a mock visualization for tests. +" +Class { + #name : #TLMockVisualization, + #superclass : #Object, + #category : #'Telescope-Core-Tests-Utils' +} + +{ #category : #'as yet unclassified' } +TLMockVisualization class >> create [ + ^ self new createVisu +] + +{ #category : #building } +TLMockVisualization >> createVisu [ + | visu | + visu := TLVisualization new. + visu nodeCreationStrategy compositeProperty: (1 to: 10) asOrderedCollection. + visu styleSheet + childrenLayout: TLLinearLayout topToBottom; + shape: TLEllipse; + nodeLabel: #mooseName; + backgroundColor: Color gray. + visu styleSheet > #children backgroundColor: Color yellow. + visu + addInteraction: TLPopUpAction onMouseOver; + addInteraction: (TLInspectAction withMenu: 'Inspect'). + visu addNodeFromEntity: 42. + ^ visu +] diff --git a/src/Telescope-Core-Tests/TLModelTest.class.st b/src/Telescope-Core-Tests/TLModelTest.class.st index f0fb3618..b208d7a9 100644 --- a/src/Telescope-Core-Tests/TLModelTest.class.st +++ b/src/Telescope-Core-Tests/TLModelTest.class.st @@ -1,61 +1,46 @@ -Class { - #name : #TLModelTest, - #superclass : #TestCase, - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #tests } -TLModelTest >> testAllNodesDoVariantsOnGroupWithNode [ - | group subGroup groupNode subGroupNode subGroupCompositeNode compositeChild | - group := TLEntitiesGroup new. - group addDrawable: (groupNode := TLSimpleNode new). - subGroup := group > #subGroup. - subGroup addDrawable: (subGroupNode := TLSimpleNode new). - subGroup addDrawable: (subGroupCompositeNode := TLCompositeNode new). - (subGroupCompositeNode addChild: (compositeChild := TLSimpleNode new)). - - self assert: group nodes equals: (TLDrawableCollection with: groupNode). - self assert: group allNodes equals: (TLDrawableCollection with: groupNode with: subGroupNode with: subGroupCompositeNode). - self assert: group allNodesRecursively equals: (TLDrawableCollection with: groupNode with: subGroupNode with: subGroupCompositeNode with: compositeChild ) -] - -{ #category : #tests } -TLModelTest >> testCompositeParentDefinition [ - | composite node | - composite:= TLCompositeNode new. - node := TLSimpleNode new. - node parentNode: composite. - self assert: node parentNode equals: composite. - self assert: composite childrenNodes asArray equals: { node } -] - -{ #category : #tests } -TLModelTest >> testRemoveAllFromGroup [ - | group node1 node2 | - group := TLEntitiesGroup new. - node1 := group addDrawable: (TLSimpleNode new). - node2 := group addDrawable: (TLSimpleNode new). - self assert: group size equals: 2. - self assert: node1 parent equals: group. - self assert: node2 parent equals: group. - group removeAll. - self assert: group size equals: 0. - self assert: node1 parent equals: nil. - self assert: node2 parent equals: nil. - -] - -{ #category : #tests } -TLModelTest >> testRemoveAllThenAddAgainGroup [ - | group subGroup secondSubGroup | - group := TLEntitiesGroup new. - subGroup := group > #group1. - self assert: subGroup parent equals: group. - group removeAll. - self assert: subGroup parent equals: nil. - self assert: group isEmpty. - self assert: group subGroupsDictionary isEmpty. - secondSubGroup := group > #group1. - self assert: secondSubGroup parent equals: group. - self deny: secondSubGroup equals: subGroup -] +Class { + #name : #TLModelTest, + #superclass : #TestCase, + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #tests } +TLModelTest >> testCompositeParentDefinition [ + | composite node | + composite:= TLCompositeNode new. + node := TLSimpleNode new. + node parentNode: composite. + self assert: node parentNode equals: composite. + self assert: composite childrenNodes asArray equals: { node } +] + +{ #category : #tests } +TLModelTest >> testRemoveAllFromGroup [ + | group node1 node2 | + group := TLEntitiesGroup new. + node1 := group addDrawable: (TLSimpleNode new). + node2 := group addDrawable: (TLSimpleNode new). + self assert: group size equals: 2. + self assert: node1 parent equals: group. + self assert: node2 parent equals: group. + group removeAll. + self assert: group size equals: 0. + self assert: node1 parent equals: nil. + self assert: node2 parent equals: nil. + +] + +{ #category : #tests } +TLModelTest >> testRemoveAllThenAddAgainGroup [ + | group subGroup secondSubGroup | + group := TLEntitiesGroup new. + subGroup := group > #group1. + self assert: subGroup parent equals: group. + group removeAll. + self assert: subGroup parent equals: nil. + self assert: group isEmpty. + self assert: group subGroupsDictionary isEmpty. + secondSubGroup := group > #group1. + self assert: secondSubGroup parent equals: group. + self deny: secondSubGroup equals: subGroup +] diff --git a/src/Telescope-Core-Tests/TLNodeCreationStrategyTest.class.st b/src/Telescope-Core-Tests/TLNodeCreationStrategyTest.class.st index 4090857b..212a402a 100644 --- a/src/Telescope-Core-Tests/TLNodeCreationStrategyTest.class.st +++ b/src/Telescope-Core-Tests/TLNodeCreationStrategyTest.class.st @@ -1,64 +1,64 @@ -Class { - #name : #TLNodeCreationStrategyTest, - #superclass : #TestCase, - #instVars : [ - 'strategy' - ], - #category : #'Telescope-Core-Tests-Strategies' -} - -{ #category : #running } -TLNodeCreationStrategyTest >> setUp [ - super setUp. - strategy := TLNodeCreationStrategy new -] - -{ #category : #tests } -TLNodeCreationStrategyTest >> testCompositePropertyFillingAddADefaultChildrenNodeCreationStrategy [ - strategy compositeProperty: #whatever. - self assert: strategy childrenStrategy notNil. -] - -{ #category : #tests } -TLNodeCreationStrategyTest >> testCompositeWithLayout [ - | node | - strategy := TLNodeCreationStrategy composite: [ :i | i + 1 to: i + 5 ] withLayout: #aFakeLayout. - node := strategy createNodeFromEntity: 6. - self assert: node isComposite. - self assert: node childrenLayout equals: #aFakeLayout -] - -{ #category : #tests } -TLNodeCreationStrategyTest >> testStrategyDefiningStyleForNode [ - | node | - strategy nodeStyle: #myStyle. - node := strategy createNodeFromEntity: #whatever. - self assert: node styles equals: {#node . #myStyle} asOrderedCollection -] - -{ #category : #tests } -TLNodeCreationStrategyTest >> testStrategyForCompositeNodeCreation [ - | node | - strategy compositeProperty: (1 to: 9). - node := strategy createNodeFromEntity: #Digit. - self assert: node isComposite. - self assert: node entity equals: #Digit. - self assert: node childrenNodes size equals: 9 -] - -{ #category : #tests } -TLNodeCreationStrategyTest >> testStrategyForCompositeNodeCreationAlsoCreatingComposite [ - | node | - (strategy compositeProperty: {1}) childrenProperty: [:i | i to: i + 1]. - node := strategy createNodeFromEntity: #Digit. - self assert: node isComposite. - self assert: node entity equals: #Digit. - self assert: node childrenNodes size equals: 1. - self assert: node childrenNodes first isComposite. - self assert: node childrenNodes first childrenNodes size equals: 2. - self assert: node childrenNodes first childrenNodes first entity equals: 1. - self assert: node childrenNodes first childrenNodes second entity equals: 2. - self deny: node childrenNodes first childrenNodes first isComposite. - self deny: node childrenNodes first childrenNodes second isComposite. - -] +Class { + #name : #TLNodeCreationStrategyTest, + #superclass : #TestCase, + #instVars : [ + 'strategy' + ], + #category : #'Telescope-Core-Tests-Strategies' +} + +{ #category : #running } +TLNodeCreationStrategyTest >> setUp [ + super setUp. + strategy := TLNodeCreationStrategy new +] + +{ #category : #tests } +TLNodeCreationStrategyTest >> testCompositePropertyFillingAddADefaultChildrenNodeCreationStrategy [ + strategy compositeProperty: #whatever. + self assert: strategy childrenStrategy notNil. +] + +{ #category : #tests } +TLNodeCreationStrategyTest >> testCompositeWithLayout [ + | node | + strategy := TLNodeCreationStrategy composite: [ :i | i + 1 to: i + 5 ] withLayout: #aFakeLayout. + node := strategy createNodeFromEntity: 6. + self assert: node isComposite. + self assert: node childrenLayout equals: #aFakeLayout +] + +{ #category : #tests } +TLNodeCreationStrategyTest >> testStrategyDefiningStyleForNode [ + | node | + strategy nodeStyle: #myStyle. + node := strategy createNodeFromEntity: #whatever. + self assert: node styles equals: {#node . #myStyle} asOrderedCollection +] + +{ #category : #tests } +TLNodeCreationStrategyTest >> testStrategyForCompositeNodeCreation [ + | node | + strategy compositeProperty: (1 to: 9). + node := strategy createNodeFromEntity: #Digit. + self assert: node isComposite. + self assert: node entity equals: #Digit. + self assert: node childrenNodes size equals: 9 +] + +{ #category : #tests } +TLNodeCreationStrategyTest >> testStrategyForCompositeNodeCreationAlsoCreatingComposite [ + | node | + (strategy compositeProperty: {1}) childrenProperty: [:i | i to: i + 1]. + node := strategy createNodeFromEntity: #Digit. + self assert: node isComposite. + self assert: node entity equals: #Digit. + self assert: node childrenNodes size equals: 1. + self assert: node childrenNodes first isComposite. + self assert: node childrenNodes first childrenNodes size equals: 2. + self assert: node childrenNodes first childrenNodes first entity equals: 1. + self assert: node childrenNodes first childrenNodes second entity equals: 2. + self deny: node childrenNodes first childrenNodes first isComposite. + self deny: node childrenNodes first childrenNodes second isComposite. + +] diff --git a/src/Telescope-Core-Tests/TLObjectTest.class.st b/src/Telescope-Core-Tests/TLObjectTest.class.st index c2cb94b9..3e263e06 100644 --- a/src/Telescope-Core-Tests/TLObjectTest.class.st +++ b/src/Telescope-Core-Tests/TLObjectTest.class.st @@ -1,39 +1,39 @@ -Class { - #name : #TLObjectTest, - #superclass : #TestCase, - #instVars : [ - 'tlObject' - ], - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #running } -TLObjectTest >> setUp [ - super setUp. - tlObject := TLObject new -] - -{ #category : #tests } -TLObjectTest >> testError [ - self should: [ tlObject error: 'Test' ] raise: TLError -] - -{ #category : #tests } -TLObjectTest >> testObtainOnBlock [ - self assert: (tlObject obtain: [ :object | {object} ] on: tlObject) equals: {tlObject} -] - -{ #category : #tests } -TLObjectTest >> testObtainOnNonExistingMethodCall [ - self should: [ tlObject obtain: #foo on: tlObject ] raise: MessageNotUnderstood -] - -{ #category : #tests } -TLObjectTest >> testObtainOnNonValuable [ - self assert: (tlObject obtain: (1 to: 5) on: tlObject) equals: (1 to: 5) -] - -{ #category : #tests } -TLObjectTest >> testObtainOnSimpleMethodCall [ - self assert: (tlObject obtain: #class on: tlObject) equals: TLObject -] +Class { + #name : #TLObjectTest, + #superclass : #TestCase, + #instVars : [ + 'tlObject' + ], + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #running } +TLObjectTest >> setUp [ + super setUp. + tlObject := TLObject new +] + +{ #category : #tests } +TLObjectTest >> testError [ + self should: [ tlObject error: 'Test' ] raise: TLError +] + +{ #category : #tests } +TLObjectTest >> testObtainOnBlock [ + self assert: (tlObject obtain: [ :object | {object} ] on: tlObject) equals: {tlObject} +] + +{ #category : #tests } +TLObjectTest >> testObtainOnNonExistingMethodCall [ + self should: [ tlObject obtain: #foo on: tlObject ] raise: MessageNotUnderstood +] + +{ #category : #tests } +TLObjectTest >> testObtainOnNonValuable [ + self assert: (tlObject obtain: (1 to: 5) on: tlObject) equals: (1 to: 5) +] + +{ #category : #tests } +TLObjectTest >> testObtainOnSimpleMethodCall [ + self assert: (tlObject obtain: #class on: tlObject) equals: TLObject +] diff --git a/src/Telescope-Core-Tests/TLObtainRequestTest.class.st b/src/Telescope-Core-Tests/TLObtainRequestTest.class.st index d1847d63..b2ccb989 100644 --- a/src/Telescope-Core-Tests/TLObtainRequestTest.class.st +++ b/src/Telescope-Core-Tests/TLObtainRequestTest.class.st @@ -1,182 +1,182 @@ -Class { - #name : #TLObtainRequestTest, - #superclass : #TestCase, - #instVars : [ - 'simple', - 'composite', - 'group', - 'collection', - 'compositeChildrenNode', - 'compositeChildrenGroup', - 'groupSimpleNode', - 'groupChildrenGroup' - ], - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #running } -TLObtainRequestTest >> setUp [ - super setUp. - simple := TLSimpleNode new. - composite := TLCompositeNode new. - group := TLEntitiesGroup new. - compositeChildrenNode := TLSimpleNode new - parent: composite; - yourself. - compositeChildrenGroup := TLEntitiesGroup new - parent: composite; - yourself. - groupSimpleNode := TLSimpleNode new - parent: group; - yourself. - groupChildrenGroup := TLEntitiesGroup new - parent: group; - yourself. - collection := TLDrawableCollection - withAll: - {simple. - composite. - group} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainAll [ - self assert: collection obtain all size equals: 3 -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainCompositeNodes [ - self assert: collection obtain compositeNodes asArray equals: {composite} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainCompositeRecursivelySimpleNodes [ - self - assert: collection obtain compositeRecursively simpleNodes asArray - equals: - {simple. - compositeChildrenNode} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainGroupRecursivelyGroups [ - self - assert: collection obtain groupRecursively groups asArray - equals: - {group. - groupChildrenGroup} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainGroupRecursivelySimpleNodes [ - self assert: collection obtain groupRecursively simpleNodes asArray equals: {simple . groupSimpleNode} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainGroups [ - self assert: collection obtain groups asArray equals: {group} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainGroupsWithSelf [ - self - assert: group obtain recursively withSelf groups asArray - equals: - {group. - groupChildrenGroup} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainNodes [ - self - assert: collection obtain nodes asArray - equals: - {simple. - composite} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainNodesFromVisualization [ - | visu | - visu := TLVisualization new. - visu addNodesFromEntities: (1 to: 3). - self assert: visu obtain nodes size equals: 3 -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainRecursivelyAll [ - self assert: collection obtain recursively all size equals: 7 -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainRecursivelyLowestVisiblesNodesCompositeExpanded [ - composite expanded: true. - self - assert: collection obtain recursively lowestVisibles nodes asArray - equals: - {simple. - compositeChildrenNode. - groupSimpleNode} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainRecursivelyLowestVisiblesNodesCompositeNotExpanded [ - composite expanded: false. - self - assert: collection obtain recursively lowestVisibles nodes asArray - equals: - {simple. - composite. - groupSimpleNode} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainRecursivelyLowestVisiblesNodesCompositeNotExpandedGroupInvisible [ - composite expanded: false. - group hide. - self - assert: collection obtain recursively lowestVisibles nodes asArray - equals: - {simple. - composite} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainRecursivelySimpleNodes [ - self - assert: collection obtain recursively simpleNodes asArray - equals: - {simple. - compositeChildrenNode. - groupSimpleNode} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainRecursivelyVisiblesNodes [ - simple hide. - composite expanded: false. - self assert: collection obtain recursively visibles nodes asArray equals: {composite. groupSimpleNode } -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainRecursivelyVisiblesNodesCompositeExpanded [ - simple hide. - composite expanded: true. - self - assert: collection obtain recursively visibles nodes asArray - equals: - {composite. - compositeChildrenNode. - groupSimpleNode} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainSimpleNodes [ - self assert: collection obtain simpleNodes asArray equals: {simple} -] - -{ #category : #tests } -TLObtainRequestTest >> testObtainVisiblesNodes [ - simple hide. - self assert: collection obtain visibles nodes asArray equals: {composite} -] +Class { + #name : #TLObtainRequestTest, + #superclass : #TestCase, + #instVars : [ + 'simple', + 'composite', + 'group', + 'collection', + 'compositeChildrenNode', + 'compositeChildrenGroup', + 'groupSimpleNode', + 'groupChildrenGroup' + ], + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #running } +TLObtainRequestTest >> setUp [ + super setUp. + simple := TLSimpleNode new. + composite := TLCompositeNode new. + group := TLEntitiesGroup new. + compositeChildrenNode := TLSimpleNode new + parent: composite; + yourself. + compositeChildrenGroup := TLEntitiesGroup new + parent: composite; + yourself. + groupSimpleNode := TLSimpleNode new + parent: group; + yourself. + groupChildrenGroup := TLEntitiesGroup new + parent: group; + yourself. + collection := TLDrawableCollection + withAll: + {simple. + composite. + group} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainAll [ + self assert: collection obtain all size equals: 3 +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainCompositeNodes [ + self assert: collection obtain compositeNodes asArray equals: {composite} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainCompositeRecursivelySimpleNodes [ + self + assert: collection obtain compositeRecursively simpleNodes asArray + equals: + {simple. + compositeChildrenNode} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainGroupRecursivelyGroups [ + self + assert: collection obtain groupRecursively groups asArray + equals: + {group. + groupChildrenGroup} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainGroupRecursivelySimpleNodes [ + self assert: collection obtain groupRecursively simpleNodes asArray equals: {simple . groupSimpleNode} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainGroups [ + self assert: collection obtain groups asArray equals: {group} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainGroupsWithSelf [ + self + assert: group obtain recursively withSelf groups asArray + equals: + {group. + groupChildrenGroup} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainNodes [ + self + assert: collection obtain nodes asArray + equals: + {simple. + composite} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainNodesFromVisualization [ + | visu | + visu := TLVisualization new. + visu addNodesFromEntities: (1 to: 3). + self assert: visu obtain nodes size equals: 3 +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainRecursivelyAll [ + self assert: collection obtain recursively all size equals: 7 +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainRecursivelyLowestVisiblesNodesCompositeExpanded [ + composite expanded: true. + self + assert: collection obtain recursively lowestVisibles nodes asArray + equals: + {simple. + compositeChildrenNode. + groupSimpleNode} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainRecursivelyLowestVisiblesNodesCompositeNotExpanded [ + composite expanded: false. + self + assert: collection obtain recursively lowestVisibles nodes asArray + equals: + {simple. + composite. + groupSimpleNode} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainRecursivelyLowestVisiblesNodesCompositeNotExpandedGroupInvisible [ + composite expanded: false. + group hide. + self + assert: collection obtain recursively lowestVisibles nodes asArray + equals: + {simple. + composite} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainRecursivelySimpleNodes [ + self + assert: collection obtain recursively simpleNodes asArray + equals: + {simple. + compositeChildrenNode. + groupSimpleNode} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainRecursivelyVisiblesNodes [ + simple hide. + composite expanded: false. + self assert: collection obtain recursively visibles nodes asArray equals: {composite. groupSimpleNode } +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainRecursivelyVisiblesNodesCompositeExpanded [ + simple hide. + composite expanded: true. + self + assert: collection obtain recursively visibles nodes asArray + equals: + {composite. + compositeChildrenNode. + groupSimpleNode} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainSimpleNodes [ + self assert: collection obtain simpleNodes asArray equals: {simple} +] + +{ #category : #tests } +TLObtainRequestTest >> testObtainVisiblesNodes [ + simple hide. + self assert: collection obtain visibles nodes asArray equals: {composite} +] diff --git a/src/Telescope-Core-Tests/TLSimpleNodeTest.class.st b/src/Telescope-Core-Tests/TLSimpleNodeTest.class.st index 71d7767d..13b47311 100644 --- a/src/Telescope-Core-Tests/TLSimpleNodeTest.class.st +++ b/src/Telescope-Core-Tests/TLSimpleNodeTest.class.st @@ -1,75 +1,75 @@ -Class { - #name : #TLSimpleNodeTest, - #superclass : #TestCase, - #instVars : [ - 'node' - ], - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #running } -TLSimpleNodeTest >> setUp [ - super setUp. - node := TLSimpleNode new -] - -{ #category : #tests } -TLSimpleNodeTest >> testAddStyleRequireUpdate [ - self deny: node isUpdateRequired. - node addStyle: #style. - self assert: node isUpdateRequired -] - -{ #category : #tests } -TLSimpleNodeTest >> testAdjacentNodes [ - | nodeFrom nodeTo | - nodeFrom := TLSimpleNode new. - nodeTo := TLSimpleNode new "shape: shape". - nodeFrom connectTo: node. - node connectTo: nodeTo. - self assert: node adjacentNodes asSet equals: { nodeFrom . nodeTo } asSet -] - -{ #category : #tests } -TLSimpleNodeTest >> testBecomeComposite [ - self deny: node isComposite. - node becomeComposite. - self assert: node isComposite -] - -{ #category : #tests } -TLSimpleNodeTest >> testConnectionCreation [ - | anotherNode visualization | - visualization := TLVisualization new. - visualization addDrawable: node. - anotherNode := TLSimpleNode new. - visualization addDrawable: anotherNode. - node connectTo: anotherNode. - self assert: node outgoingConnections size equals: 1. - self assert: anotherNode incomingConnections size equals: 1. - self assert: node outgoingConnections first equals: anotherNode incomingConnections first -] - -{ #category : #tests } -TLSimpleNodeTest >> testInteractions [ - self assert: node interactions size equals: 0. - node addInteraction: TLPopUpAction onMouseOver. - self assert: node interactions size equals: 1. - -] - -{ #category : #tests } -TLSimpleNodeTest >> testIsGroup [ - self deny: node isGroup -] - -{ #category : #tests } -TLSimpleNodeTest >> testSimpleNodeBecameParent [ - | child | - child := TLSimpleNode new. - child parent: node. - self assert: node isComposite. - self assert: node childrenNodes size equals: 1. - self assert: child parent equals: node. - self assert: node isUpdateRequired -] +Class { + #name : #TLSimpleNodeTest, + #superclass : #TestCase, + #instVars : [ + 'node' + ], + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #running } +TLSimpleNodeTest >> setUp [ + super setUp. + node := TLSimpleNode new +] + +{ #category : #tests } +TLSimpleNodeTest >> testAddStyleRequireUpdate [ + self deny: node isUpdateRequired. + node addStyle: #style. + self assert: node isUpdateRequired +] + +{ #category : #tests } +TLSimpleNodeTest >> testAdjacentNodes [ + | nodeFrom nodeTo | + nodeFrom := TLSimpleNode new. + nodeTo := TLSimpleNode new "shape: shape". + nodeFrom connectTo: node. + node connectTo: nodeTo. + self assert: node adjacentNodes asSet equals: { nodeFrom . nodeTo } asSet +] + +{ #category : #tests } +TLSimpleNodeTest >> testBecomeComposite [ + self deny: node isComposite. + node becomeComposite. + self assert: node isComposite +] + +{ #category : #tests } +TLSimpleNodeTest >> testConnectionCreation [ + | anotherNode visualization | + visualization := TLVisualization new. + visualization addDrawable: node. + anotherNode := TLSimpleNode new. + visualization addDrawable: anotherNode. + node connectTo: anotherNode. + self assert: node outgoingConnections size equals: 1. + self assert: anotherNode incomingConnections size equals: 1. + self assert: node outgoingConnections first equals: anotherNode incomingConnections first +] + +{ #category : #tests } +TLSimpleNodeTest >> testInteractions [ + self assert: node interactions size equals: 0. + node addInteraction: TLPopUpAction onMouseOver. + self assert: node interactions size equals: 1. + +] + +{ #category : #tests } +TLSimpleNodeTest >> testIsGroup [ + self deny: node isGroup +] + +{ #category : #tests } +TLSimpleNodeTest >> testSimpleNodeBecameParent [ + | child | + child := TLSimpleNode new. + child parent: node. + self assert: node isComposite. + self assert: node childrenNodes size equals: 1. + self assert: child parent equals: node. + self assert: node isUpdateRequired +] diff --git a/src/Telescope-Core-Tests/TLSortingStrategiesTest.class.st b/src/Telescope-Core-Tests/TLSortingStrategiesTest.class.st index 4dc77d46..82dea5c6 100644 --- a/src/Telescope-Core-Tests/TLSortingStrategiesTest.class.st +++ b/src/Telescope-Core-Tests/TLSortingStrategiesTest.class.st @@ -1,60 +1,60 @@ -Class { - #name : #TLSortingStrategiesTest, - #superclass : #TestCase, - #instVars : [ - 'strategy', - 'group', - 'order' - ], - #category : #'Telescope-Core-Tests-Strategies' -} - -{ #category : #running } -TLSortingStrategiesTest >> setUp [ - super setUp. - order := #(4 8 3 9 5 2 7 1 6 10). - group := TLEntitiesGroup new - addAllDrawables: - (order - collect: [ :i | - TLSimpleNode new - entity: i; - yourself ]). -] - -{ #category : #tests } -TLSortingStrategiesTest >> testComparableUsingStrategyAddNewElementAtTheEnd [ - group sortingStrategy: TLComparableUsingStrategy new. - group addDrawable: (TLSimpleNode new entity: 6). - self assert: (group collect: #entity) asArray equals: #(1 2 3 4 5 6 6 7 8 9 10) -] - -{ #category : #tests } -TLSortingStrategiesTest >> testComparableUsingStrategySortCorrectly [ - strategy := TLComparableUsingStrategy new. - self assert: (group collect: #entity) asArray equals: order. - strategy sortNodes: group. - self assert: (group collect: #entity) asArray equals: (1 to: 10) asArray -] - -{ #category : #tests } -TLSortingStrategiesTest >> testComparableUsingStrategySortExistingContent [ - self assert: (group collect: #entity) asArray equals: order. - group sortingStrategy: TLComparableUsingStrategy new. - self assert: (group collect: #entity) asArray equals: #(1 2 3 4 5 6 7 8 9 10) -] - -{ #category : #tests } -TLSortingStrategiesTest >> testKeepingOrderStrategyAddNewElementAtTheEnd [ - group sortingStrategy: TLKeepingOrderStrategy new. - group addDrawable: (TLSimpleNode new entity: 6). - self assert: (group collect: #entity) asArray equals: order , {6} -] - -{ #category : #tests } -TLSortingStrategiesTest >> testKeepingStrategyKeepOrder [ - strategy := TLKeepingOrderStrategy new. - self assert: (group collect: #entity) asArray equals: order. - strategy sortNodes: group. - self assert: (group collect: #entity) asArray equals: order -] +Class { + #name : #TLSortingStrategiesTest, + #superclass : #TestCase, + #instVars : [ + 'strategy', + 'group', + 'order' + ], + #category : #'Telescope-Core-Tests-Strategies' +} + +{ #category : #running } +TLSortingStrategiesTest >> setUp [ + super setUp. + order := #(4 8 3 9 5 2 7 1 6 10). + group := TLEntitiesGroup new + addAllDrawables: + (order + collect: [ :i | + TLSimpleNode new + entity: i; + yourself ]). +] + +{ #category : #tests } +TLSortingStrategiesTest >> testComparableUsingStrategyAddNewElementAtTheEnd [ + group sortingStrategy: TLComparableUsingStrategy new. + group addDrawable: (TLSimpleNode new entity: 6). + self assert: (group collect: #entity) asArray equals: #(1 2 3 4 5 6 6 7 8 9 10) +] + +{ #category : #tests } +TLSortingStrategiesTest >> testComparableUsingStrategySortCorrectly [ + strategy := TLComparableUsingStrategy new. + self assert: (group collect: #entity) asArray equals: order. + strategy sortNodes: group. + self assert: (group collect: #entity) asArray equals: (1 to: 10) asArray +] + +{ #category : #tests } +TLSortingStrategiesTest >> testComparableUsingStrategySortExistingContent [ + self assert: (group collect: #entity) asArray equals: order. + group sortingStrategy: TLComparableUsingStrategy new. + self assert: (group collect: #entity) asArray equals: #(1 2 3 4 5 6 7 8 9 10) +] + +{ #category : #tests } +TLSortingStrategiesTest >> testKeepingOrderStrategyAddNewElementAtTheEnd [ + group sortingStrategy: TLKeepingOrderStrategy new. + group addDrawable: (TLSimpleNode new entity: 6). + self assert: (group collect: #entity) asArray equals: order , {6} +] + +{ #category : #tests } +TLSortingStrategiesTest >> testKeepingStrategyKeepOrder [ + strategy := TLKeepingOrderStrategy new. + self assert: (group collect: #entity) asArray equals: order. + strategy sortNodes: group. + self assert: (group collect: #entity) asArray equals: order +] diff --git a/src/Telescope-Core-Tests/TLStyleSheetTest.class.st b/src/Telescope-Core-Tests/TLStyleSheetTest.class.st index 5879072e..d03476c6 100644 --- a/src/Telescope-Core-Tests/TLStyleSheetTest.class.st +++ b/src/Telescope-Core-Tests/TLStyleSheetTest.class.st @@ -1,59 +1,59 @@ -Class { - #name : #TLStyleSheetTest, - #superclass : #TestCase, - #instVars : [ - 'stylesheet' - ], - #category : #'Telescope-Core-Tests-Style' -} - -{ #category : #running } -TLStyleSheetTest >> setUp [ - super setUp. - stylesheet := TLStyleSheet new -] - -{ #category : #tests } -TLStyleSheetTest >> testCreation [ -] - -{ #category : #tests } -TLStyleSheetTest >> testObtainValueForEntityWithBlock [ - stylesheet color: [:entity | Color red]. - self assert: (stylesheet obtainValue: #color forEntity: 1 inNode: #node) equals: Color red -] - -{ #category : #tests } -TLStyleSheetTest >> testObtainValueForEntityWithDirectValue [ - stylesheet color: Color red. - self assert: (stylesheet obtainValue: #color forEntity: 1 inNode: #node) equals: Color red -] - -{ #category : #tests } -TLStyleSheetTest >> testObtainValueForEntityWithGradient [ - stylesheet color: (Color red property: #yourself gradientAt: 1). - self assert: (stylesheet obtainValue: #color forEntity: 1 inNode: #node) equals: Color red -] - -{ #category : #tests } -TLStyleSheetTest >> testObtainValueForEntityWithStringDirectValue [ - stylesheet nodeLabel: 'Foo'. - self assert: (stylesheet obtainValue: #nodeLabel forEntity: 1 inNode: #node) equals: 'Foo' -] - -{ #category : #tests } -TLStyleSheetTest >> testObtainValueForEntityWithSymbol [ - stylesheet color: #red. - self assert: (stylesheet obtainValue: #color forEntity: Color inNode: #node) equals: Color red -] - -{ #category : #tests } -TLStyleSheetTest >> testObtainValueForEntityWithWrongBlock [ - stylesheet color: [ :entity | entity foo ]. - self should: [ stylesheet obtainValue: #color forEntity: 1 inNode: #node ] raise: TLStyleSheetPropertyBadlyUsed -] - -{ #category : #tests } -TLStyleSheetTest >> testObtainValueWithMissingProperty [ - self should: [ stylesheet obtainValue: #color forEntity: 1 inNode: #node] raise: TLStyleSheetMissingProperty -] +Class { + #name : #TLStyleSheetTest, + #superclass : #TestCase, + #instVars : [ + 'stylesheet' + ], + #category : #'Telescope-Core-Tests-Style' +} + +{ #category : #running } +TLStyleSheetTest >> setUp [ + super setUp. + stylesheet := TLStyleSheet new +] + +{ #category : #tests } +TLStyleSheetTest >> testCreation [ +] + +{ #category : #tests } +TLStyleSheetTest >> testObtainValueForEntityWithBlock [ + stylesheet color: [:entity | Color red]. + self assert: (stylesheet obtainValue: #color forEntity: 1 inNode: #node) equals: Color red +] + +{ #category : #tests } +TLStyleSheetTest >> testObtainValueForEntityWithDirectValue [ + stylesheet color: Color red. + self assert: (stylesheet obtainValue: #color forEntity: 1 inNode: #node) equals: Color red +] + +{ #category : #tests } +TLStyleSheetTest >> testObtainValueForEntityWithGradient [ + stylesheet color: (Color red property: #yourself gradientAt: 1). + self assert: (stylesheet obtainValue: #color forEntity: 1 inNode: #node) equals: Color red +] + +{ #category : #tests } +TLStyleSheetTest >> testObtainValueForEntityWithStringDirectValue [ + stylesheet nodeLabel: 'Foo'. + self assert: (stylesheet obtainValue: #nodeLabel forEntity: 1 inNode: #node) equals: 'Foo' +] + +{ #category : #tests } +TLStyleSheetTest >> testObtainValueForEntityWithSymbol [ + stylesheet color: #red. + self assert: (stylesheet obtainValue: #color forEntity: Color inNode: #node) equals: Color red +] + +{ #category : #tests } +TLStyleSheetTest >> testObtainValueForEntityWithWrongBlock [ + stylesheet color: [ :entity | entity foo ]. + self should: [ stylesheet obtainValue: #color forEntity: 1 inNode: #node ] raise: TLStyleSheetPropertyBadlyUsed +] + +{ #category : #tests } +TLStyleSheetTest >> testObtainValueWithMissingProperty [ + self should: [ stylesheet obtainValue: #color forEntity: 1 inNode: #node] raise: TLStyleSheetMissingProperty +] diff --git a/src/Telescope-Core-Tests/TLTelescopeTest.class.st b/src/Telescope-Core-Tests/TLTelescopeTest.class.st index 9f6b7a4b..cd018e50 100644 --- a/src/Telescope-Core-Tests/TLTelescopeTest.class.st +++ b/src/Telescope-Core-Tests/TLTelescopeTest.class.st @@ -1,65 +1,65 @@ -Class { - #name : #TLTelescopeTest, - #superclass : #TLWithTestConnectorTest, - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #helpers } -TLTelescopeTest >> demos [ - | falsePositives | - falsePositives := #(#exampleTwoConnectedVisualization). - ^ TLDemos class methods select: [ :m | (m selector beginsWith: 'example') and: [ (falsePositives includes: m selector) not ] ] -] - -{ #category : #helpers } -TLTelescopeTest >> packagesPrefix [ - ^ 'Telescope' -] - -{ #category : #helpers } -TLTelescopeTest >> telescopeTestClasses [ - ^ (RPackageOrganizer default packages select: [ :e | e name beginsWith: self packagesPrefix ] thenCollect: [ :p | p definedClasses select: [ :class | class inheritsFrom: TestCase ] ]) flatten -] - -{ #category : #tests } -TLTelescopeTest >> testAndMakeSureSuperSetupIsCalledAsFirstMessageInSetupMethodsOfTestCases [ - "Verify that each setUp method in a unit test starts with a call to super setUp as first message sent" - - | violating tester | - self flag: #pharo6. - SystemVersion current major < 7 ifTrue: [ self skip ]. - violating := OrderedCollection new. - - tester := self class environment classNamed: (SystemVersion current major < 9 ifTrue: [ #ShouldSendSuperSetUpAsFirstMessage ] ifFalse: [ #ReShouldSendSuperSetUpAsFirstMessage ]). - self telescopeTestClasses - do: [ :each | each compiledMethodAt: #setUp ifPresent: [ :method | (tester superSetUpNotCalledFirstIn: method) ifTrue: [ violating add: method ] ] ifAbsent: nil ]. - - self assertEmpty: violating -] - -{ #category : #tests } -TLTelescopeTest >> testAndMakeSureSuperTearDownIsCalledAsLastMessageInTearDownMethodsOfTestCases [ - "Verify that each tearDown method in a unit test ends with a call to super tearDown as last message sent" - - | violating tester | - self flag: #pharo6. - SystemVersion current major < 7 ifTrue: [ self skip ]. - violating := OrderedCollection new. - - tester := self class environment classNamed: (SystemVersion current major < 9 ifTrue: [ #ShouldSendSuperTearDownAsLastMessage ] ifFalse: [ #ReShouldSendSuperTearDownAsLastMessage ]). - self telescopeTestClasses - do: [ :each | each compiledMethodAt: #tearDown ifPresent: [ :method | (tester superTearDownNotCalledLastIn: method) ifTrue: [ violating add: method ] ] ifAbsent: nil ]. - - self assertEmpty: violating -] - -{ #category : #tests } -TLTelescopeTest >> testDemoHaveRightScriptPragmas [ - self demos - do: [ :method | self assert: (method sourceCode includesSubstring: '') description: 'TLDemos class>>' , method selector , ' has no or wrong script pragma' ] -] - -{ #category : #tests } -TLTelescopeTest >> testSmokeTestsOnDemos [ - self demos do: [ :demo | self shouldnt: [ TLDemos executeDemo: demo selector ] raise: Error description: 'TLDemo class>>' , demo selector , ' is failing.' ] -] +Class { + #name : #TLTelescopeTest, + #superclass : #TLWithTestConnectorTest, + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #helpers } +TLTelescopeTest >> demos [ + | falsePositives | + falsePositives := #(#exampleTwoConnectedVisualization). + ^ TLDemos class methods select: [ :m | (m selector beginsWith: 'example') and: [ (falsePositives includes: m selector) not ] ] +] + +{ #category : #helpers } +TLTelescopeTest >> packagesPrefix [ + ^ 'Telescope' +] + +{ #category : #helpers } +TLTelescopeTest >> telescopeTestClasses [ + ^ (RPackageOrganizer default packages select: [ :e | e name beginsWith: self packagesPrefix ] thenCollect: [ :p | p definedClasses select: [ :class | class inheritsFrom: TestCase ] ]) flatten +] + +{ #category : #tests } +TLTelescopeTest >> testAndMakeSureSuperSetupIsCalledAsFirstMessageInSetupMethodsOfTestCases [ + "Verify that each setUp method in a unit test starts with a call to super setUp as first message sent" + + | violating tester | + self flag: #pharo6. + SystemVersion current major < 7 ifTrue: [ self skip ]. + violating := OrderedCollection new. + + tester := self class environment classNamed: (SystemVersion current major < 9 ifTrue: [ #ShouldSendSuperSetUpAsFirstMessage ] ifFalse: [ #ReShouldSendSuperSetUpAsFirstMessage ]). + self telescopeTestClasses + do: [ :each | each compiledMethodAt: #setUp ifPresent: [ :method | (tester superSetUpNotCalledFirstIn: method) ifTrue: [ violating add: method ] ] ifAbsent: nil ]. + + self assertEmpty: violating +] + +{ #category : #tests } +TLTelescopeTest >> testAndMakeSureSuperTearDownIsCalledAsLastMessageInTearDownMethodsOfTestCases [ + "Verify that each tearDown method in a unit test ends with a call to super tearDown as last message sent" + + | violating tester | + self flag: #pharo6. + SystemVersion current major < 7 ifTrue: [ self skip ]. + violating := OrderedCollection new. + + tester := self class environment classNamed: (SystemVersion current major < 9 ifTrue: [ #ShouldSendSuperTearDownAsLastMessage ] ifFalse: [ #ReShouldSendSuperTearDownAsLastMessage ]). + self telescopeTestClasses + do: [ :each | each compiledMethodAt: #tearDown ifPresent: [ :method | (tester superTearDownNotCalledLastIn: method) ifTrue: [ violating add: method ] ] ifAbsent: nil ]. + + self assertEmpty: violating +] + +{ #category : #tests } +TLTelescopeTest >> testDemoHaveRightScriptPragmas [ + self demos + do: [ :method | self assert: (method sourceCode includesSubstring: '') description: 'TLDemos class>>' , method selector , ' has no or wrong script pragma' ] +] + +{ #category : #tests } +TLTelescopeTest >> testSmokeTestsOnDemos [ + self demos do: [ :demo | self shouldnt: [ TLDemos executeDemo: demo selector ] raise: Error description: 'TLDemo class>>' , demo selector , ' is failing.' ] +] diff --git a/src/Telescope-Core-Tests/TLTestConnector.class.st b/src/Telescope-Core-Tests/TLTestConnector.class.st index aafa78e2..e978b8c0 100644 --- a/src/Telescope-Core-Tests/TLTestConnector.class.st +++ b/src/Telescope-Core-Tests/TLTestConnector.class.st @@ -1,156 +1,156 @@ -" -I am an implementation of the abstract class TLConnector used to create test on it. -" -Class { - #name : #TLTestConnector, - #superclass : #TLConnector, - #instVars : [ - 'view', - 'childrenByParent' - ], - #category : #'Telescope-Core-Tests-Utils' -} - -{ #category : #testing } -TLTestConnector class >> isRealConnector [ - ^ false -] - -{ #category : #accessing } -TLTestConnector class >> priority [ - ^ 1 -] - -{ #category : #view } -TLTestConnector >> addElementConnectionInView: anAssociation [ - -] - -{ #category : #view } -TLTestConnector >> addElementInteractionInView: element [ - self view add: element -] - -{ #category : #view } -TLTestConnector >> addElementLegendInView: legend [ - "Here we have nothing to do" -] - -{ #category : #view } -TLTestConnector >> addElementNodeInView: anElement [ - view add: anElement -] - -{ #category : #layout } -TLTestConnector >> applyLayoutOf: aTLEntitiesGroup on: aCollection [ - "doNothing" -] - -{ #category : #accessing } -TLTestConnector >> childrenByParent [ - ^ childrenByParent -] - -{ #category : #accessing } -TLTestConnector >> childrenByParent: anObject [ - childrenByParent := anObject -] - -{ #category : #accessing } -TLTestConnector >> connectionHeadShapesAvailableForConnector [ - "I should return all Telescope shapes that can apply on a connection heads for this connector." - - ^ TLSimpleShape allSubclasses -] - -{ #category : #'generation - connection' } -TLTestConnector >> createElementConnection: aTLConnection From: aTLSimpleNode to: aTargetTLSimpleNode [ - ^ aTLConnection -> (aTLSimpleNode -> aTargetTLSimpleNode) -] - -{ #category : #'generation - interaction' } -TLTestConnector >> createElementFromTrigger: aTLShapeTrigger [ - ^ aTLShapeTrigger -> #element -] - -{ #category : #'generation - node' } -TLTestConnector >> createElementNodeFromNode: aTLSimpleNode [ - ^ aTLSimpleNode -> #element -] - -{ #category : #'generation - group' } -TLTestConnector >> createGroup: aGroup with: aCollection [ - ^ aCollection as: OrderedCollection -] - -{ #category : #'generation - legend' } -TLTestConnector >> createLegendFrom: aCollection [ - "For now I do nothing. Change it if you want to test the legend" -] - -{ #category : #'generation - node' } -TLTestConnector >> define: anAssociation asParentFor: children [ - self childrenByParent at: anAssociation key put: children -] - -{ #category : #'generation - interaction' } -TLTestConnector >> generateClickInteraction: aTLClickInteraction onDrawable: aTLShapeTrigger targetingDrawable: aTLSimpleNode [ - -] - -{ #category : #initialization } -TLTestConnector >> initialize [ - super initialize. - view := OrderedCollection new. - childrenByParent := Dictionary new. -] - -{ #category : #accessing } -TLTestConnector >> nodesShapesAvailableForConnector [ - ^ TLSimpleShape allSubclasses -] - -{ #category : #placing } -TLTestConnector >> placeElement: anAssociation correspondingToTrigger: aTLShapeTrigger relativeToDrawable: aTLSimpleNode [ - -] - -{ #category : #view } -TLTestConnector >> removeElementConnectionFromView: anAssociation [ - self shapeByDrawable removeKey: anAssociation key. -] - -{ #category : #'drawing - removing' } -TLTestConnector >> removeElementFromView: anAssociation associatedToDrawable: aTLDrawable [ - self view remove: anAssociation. -] - -{ #category : #'updating - node' } -TLTestConnector >> updateElementNodeOf: aTLSimpleNode [ - -] - -{ #category : #'updating - interaction' } -TLTestConnector >> updateInteractionsOf: aTLCompositeNode [ - self flag: 'No interactions test in the fake now' -] - -{ #category : #'updating - legend' } -TLTestConnector >> updateLegend: aTLStaticLegend [ - -] - -{ #category : #view } -TLTestConnector >> updateViewForVisualization: aTLVisualization [ - -] - -{ #category : #accessing } -TLTestConnector >> view [ - ^ view -] - -{ #category : #accessing } -TLTestConnector >> view: anObject [ - view := anObject -] +" +I am an implementation of the abstract class TLConnector used to create test on it. +" +Class { + #name : #TLTestConnector, + #superclass : #TLConnector, + #instVars : [ + 'view', + 'childrenByParent' + ], + #category : #'Telescope-Core-Tests-Utils' +} + +{ #category : #testing } +TLTestConnector class >> isRealConnector [ + ^ false +] + +{ #category : #accessing } +TLTestConnector class >> priority [ + ^ 1 +] + +{ #category : #view } +TLTestConnector >> addElementConnectionInView: anAssociation [ + +] + +{ #category : #view } +TLTestConnector >> addElementInteractionInView: element [ + self view add: element +] + +{ #category : #view } +TLTestConnector >> addElementLegendInView: legend [ + "Here we have nothing to do" +] + +{ #category : #view } +TLTestConnector >> addElementNodeInView: anElement [ + view add: anElement +] + +{ #category : #layout } +TLTestConnector >> applyLayoutOf: aTLEntitiesGroup on: aCollection [ + "doNothing" +] + +{ #category : #accessing } +TLTestConnector >> childrenByParent [ + ^ childrenByParent +] + +{ #category : #accessing } +TLTestConnector >> childrenByParent: anObject [ + childrenByParent := anObject +] + +{ #category : #accessing } +TLTestConnector >> connectionHeadShapesAvailableForConnector [ + "I should return all Telescope shapes that can apply on a connection heads for this connector." + + ^ TLSimpleShape allSubclasses +] + +{ #category : #'generation - connection' } +TLTestConnector >> createElementConnection: aTLConnection From: aTLSimpleNode to: aTargetTLSimpleNode [ + ^ aTLConnection -> (aTLSimpleNode -> aTargetTLSimpleNode) +] + +{ #category : #'generation - interaction' } +TLTestConnector >> createElementFromTrigger: aTLShapeTrigger [ + ^ aTLShapeTrigger -> #element +] + +{ #category : #'generation - node' } +TLTestConnector >> createElementNodeFromNode: aTLSimpleNode [ + ^ aTLSimpleNode -> #element +] + +{ #category : #'generation - group' } +TLTestConnector >> createGroup: aGroup with: aCollection [ + ^ aCollection as: OrderedCollection +] + +{ #category : #'generation - legend' } +TLTestConnector >> createLegendFrom: aCollection [ + "For now I do nothing. Change it if you want to test the legend" +] + +{ #category : #'generation - node' } +TLTestConnector >> define: anAssociation asParentFor: children [ + self childrenByParent at: anAssociation key put: children +] + +{ #category : #'generation - interaction' } +TLTestConnector >> generateClickInteraction: aTLClickInteraction onDrawable: aTLShapeTrigger targetingDrawable: aTLSimpleNode [ + +] + +{ #category : #initialization } +TLTestConnector >> initialize [ + super initialize. + view := OrderedCollection new. + childrenByParent := Dictionary new. +] + +{ #category : #accessing } +TLTestConnector >> nodesShapesAvailableForConnector [ + ^ TLSimpleShape allSubclasses +] + +{ #category : #placing } +TLTestConnector >> placeElement: anAssociation correspondingToTrigger: aTLShapeTrigger relativeToDrawable: aTLSimpleNode [ + +] + +{ #category : #view } +TLTestConnector >> removeElementConnectionFromView: anAssociation [ + self shapeByDrawable removeKey: anAssociation key. +] + +{ #category : #'drawing - removing' } +TLTestConnector >> removeElementFromView: anAssociation associatedToDrawable: aTLDrawable [ + self view remove: anAssociation. +] + +{ #category : #'updating - node' } +TLTestConnector >> updateElementNodeOf: aTLSimpleNode [ + +] + +{ #category : #'updating - interaction' } +TLTestConnector >> updateInteractionsOf: aTLCompositeNode [ + self flag: 'No interactions test in the fake now' +] + +{ #category : #'updating - legend' } +TLTestConnector >> updateLegend: aTLStaticLegend [ + +] + +{ #category : #view } +TLTestConnector >> updateViewForVisualization: aTLVisualization [ + +] + +{ #category : #accessing } +TLTestConnector >> view [ + ^ view +] + +{ #category : #accessing } +TLTestConnector >> view: anObject [ + view := anObject +] diff --git a/src/Telescope-Core-Tests/TLVisualizationBuilderTest.class.st b/src/Telescope-Core-Tests/TLVisualizationBuilderTest.class.st index 96bf68e4..73f5c95b 100644 --- a/src/Telescope-Core-Tests/TLVisualizationBuilderTest.class.st +++ b/src/Telescope-Core-Tests/TLVisualizationBuilderTest.class.st @@ -1,41 +1,41 @@ -Class { - #name : #TLVisualizationBuilderTest, - #superclass : #TestCase, - #instVars : [ - 'mockGenerator', - 'visualization' - ], - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #running } -TLVisualizationBuilderTest >> setUp [ - super setUp. - visualization := TLVisualization new. - mockGenerator := Mock named: 'generator'. - visualization generator: mockGenerator. -] - -{ #category : #tests } -TLVisualizationBuilderTest >> testAddEntitiesinGroup [ - visualization > #testGroup addNodesFromEntities: (1 to: 5). - self assert: (visualization subGroupsDictionary includesKey: #testGroup). - self assert: (visualization subGroupsDictionary at: #testGroup) size equals: 5. -] - -{ #category : #tests } -TLVisualizationBuilderTest >> testConnectEntitiesTo [ - visualization > #testGroup addNodesFromEntities: (1 to: 5). - visualization > #testGroup connectInsideGroupEntities: (1 to: 3) to: (4 to: 5). - self assert: visualization allConnections size equals: 6 -] - -{ #category : #tests } -TLVisualizationBuilderTest >> testGroupIsCreated [ - | group | - self assert: visualization subGroupsDictionary size equals: 0. - group := visualization > #test. - self assert: visualization subGroupsDictionary size equals: 1. - self assert: group isEmpty. - -] +Class { + #name : #TLVisualizationBuilderTest, + #superclass : #TestCase, + #instVars : [ + 'mockGenerator', + 'visualization' + ], + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #running } +TLVisualizationBuilderTest >> setUp [ + super setUp. + visualization := TLVisualization new. + mockGenerator := Mock named: 'generator'. + visualization generator: mockGenerator. +] + +{ #category : #tests } +TLVisualizationBuilderTest >> testAddEntitiesinGroup [ + visualization > #testGroup addNodesFromEntities: (1 to: 5). + self assert: (visualization subGroupsDictionary includesKey: #testGroup). + self assert: (visualization subGroupsDictionary at: #testGroup) size equals: 5. +] + +{ #category : #tests } +TLVisualizationBuilderTest >> testConnectEntitiesTo [ + visualization > #testGroup addNodesFromEntities: (1 to: 5). + visualization > #testGroup connectInsideGroupEntities: (1 to: 3) to: (4 to: 5). + self assert: visualization allConnections size equals: 6 +] + +{ #category : #tests } +TLVisualizationBuilderTest >> testGroupIsCreated [ + | group | + self assert: visualization subGroupsDictionary size equals: 0. + group := visualization > #test. + self assert: visualization subGroupsDictionary size equals: 1. + self assert: group isEmpty. + +] diff --git a/src/Telescope-Core-Tests/TLVisualizationTest.class.st b/src/Telescope-Core-Tests/TLVisualizationTest.class.st index 1f67a730..c9cf8947 100644 --- a/src/Telescope-Core-Tests/TLVisualizationTest.class.st +++ b/src/Telescope-Core-Tests/TLVisualizationTest.class.st @@ -1,39 +1,39 @@ -Class { - #name : #TLVisualizationTest, - #superclass : #TestCase, - #instVars : [ - 'visualization' - ], - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #running } -TLVisualizationTest >> setUp [ - super setUp. - visualization := TLMockVisualization create -] - -{ #category : #tests } -TLVisualizationTest >> testChildrenNodeInVisu [ - self assert: visualization allChildrenNodes first effectiveStyleSheet backgroundColor equals: Color yellow. - self assert: visualization allChildrenNodes first effectiveStyleSheet shape equals: TLEllipse. -] - -{ #category : #tests } -TLVisualizationTest >> testRemovedNodeHasNoConnection [ - | node | - visualization > #one addNodesFromEntities: (1 to: 4). - node := visualization > #two addNodeFromEntity: 5. - visualization > #three addNodesFromEntities: (6 to: 10). - visualization > #one connectTo: visualization > #two. - visualization > #two connectTo: visualization > #three. - (visualization > #two) removeAll. - self assert: node allConnections isEmpty. - (visualization > #one) do: [ :aNode | self assert: aNode allConnections isEmpty ]. - (visualization > #three) do: [ :aNode | self assert: aNode allConnections isEmpty ] -] - -{ #category : #tests } -TLVisualizationTest >> testVisualizationLayout [ - self assert: (visualization layout isKindOf: TLLinearLayout ) -] +Class { + #name : #TLVisualizationTest, + #superclass : #TestCase, + #instVars : [ + 'visualization' + ], + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #running } +TLVisualizationTest >> setUp [ + super setUp. + visualization := TLMockVisualization create +] + +{ #category : #tests } +TLVisualizationTest >> testChildrenNodeInVisu [ + self assert: visualization allChildrenNodes first effectiveStyleSheet backgroundColor equals: Color yellow. + self assert: visualization allChildrenNodes first effectiveStyleSheet shape equals: TLEllipse. +] + +{ #category : #tests } +TLVisualizationTest >> testRemovedNodeHasNoConnection [ + | node | + visualization > #one addNodesFromEntities: (1 to: 4). + node := visualization > #two addNodeFromEntity: 5. + visualization > #three addNodesFromEntities: (6 to: 10). + visualization > #one connectTo: visualization > #two. + visualization > #two connectTo: visualization > #three. + (visualization > #two) removeAll. + self assert: node allConnections isEmpty. + (visualization > #one) do: [ :aNode | self assert: aNode allConnections isEmpty ]. + (visualization > #three) do: [ :aNode | self assert: aNode allConnections isEmpty ] +] + +{ #category : #tests } +TLVisualizationTest >> testVisualizationLayout [ + self assert: (visualization layout isKindOf: TLLinearLayout ) +] diff --git a/src/Telescope-Core-Tests/TLWithTestConnectorTest.class.st b/src/Telescope-Core-Tests/TLWithTestConnectorTest.class.st index f3f09e7b..c0ae5f3d 100644 --- a/src/Telescope-Core-Tests/TLWithTestConnectorTest.class.st +++ b/src/Telescope-Core-Tests/TLWithTestConnectorTest.class.st @@ -1,15 +1,15 @@ -Class { - #name : #TLWithTestConnectorTest, - #superclass : #TestCase, - #category : #'Telescope-Core-Tests-Model' -} - -{ #category : #testing } -TLWithTestConnectorTest class >> isAbstract [ - ^ self = TLWithTestConnectorTest -] - -{ #category : #private } -TLWithTestConnectorTest >> performTest [ - TLCurrentConnector value: TLTestConnector during: [ super performTest ] -] +Class { + #name : #TLWithTestConnectorTest, + #superclass : #TestCase, + #category : #'Telescope-Core-Tests-Model' +} + +{ #category : #testing } +TLWithTestConnectorTest class >> isAbstract [ + ^ self = TLWithTestConnectorTest +] + +{ #category : #private } +TLWithTestConnectorTest >> performTest [ + TLCurrentConnector value: TLTestConnector during: [ super performTest ] +] diff --git a/src/Telescope-Core-Tests/package.st b/src/Telescope-Core-Tests/package.st index 2dbafd50..8697ad4b 100644 --- a/src/Telescope-Core-Tests/package.st +++ b/src/Telescope-Core-Tests/package.st @@ -1 +1 @@ -Package { #name : #'Telescope-Core-Tests' } +Package { #name : #'Telescope-Core-Tests' } diff --git a/src/Telescope-Core/TLClientAction.class.st b/src/Telescope-Core/TLClientAction.class.st index 05995c09..4912bddb 100644 --- a/src/Telescope-Core/TLClientAction.class.st +++ b/src/Telescope-Core/TLClientAction.class.st @@ -2,8 +2,7 @@ Class { #name : #TLClientAction, #superclass : #TLDrawableAction, #instVars : [ - 'scriptDSL', - 'eventType' + 'scriptDSL' ], #category : #'Telescope-Core-Actions' } diff --git a/src/Telescope-Core/TLConnector.class.st b/src/Telescope-Core/TLConnector.class.st index 2baa94ef..d5d1e4c8 100644 --- a/src/Telescope-Core/TLConnector.class.st +++ b/src/Telescope-Core/TLConnector.class.st @@ -532,6 +532,12 @@ TLConnector >> nodesShapesAvailableForConnector [ ^ self subclassResponsibility ] +{ #category : #accessing } +TLConnector >> notify: aString forVisualization: aTLVisualizaton [ + + self subclassResponsibility +] + { #category : #opening } TLConnector >> open: aTLVisualization inWindowSized: aDimension titled: aString [ self subclassResponsibility diff --git a/src/Telescope-Core/TLVisualization.class.st b/src/Telescope-Core/TLVisualization.class.st index 92a5412e..55f755cd 100644 --- a/src/Telescope-Core/TLVisualization.class.st +++ b/src/Telescope-Core/TLVisualization.class.st @@ -142,6 +142,11 @@ TLVisualization >> legend: aTLLegend [ aTLLegend parent: self ] +{ #category : #'ui - notifying' } +TLVisualization >> notify: aString [ + self generator notify: aString forVisualization: self +] + { #category : #'instance creation' } TLVisualization >> open [ [ self generator open: self inWindowSized: self openingDimension titled: self title ]