From cc6bae26a29c6c91919500f553d597058bacaead Mon Sep 17 00:00:00 2001 From: fouziray Date: Sun, 29 Jun 2025 11:51:07 +0200 Subject: [PATCH] moving drTests related packages ( removing them from Pharo --> to newTools) --- .../BaselineOfDrTests.class.st | 45 -- src/BaselineOfDrTests/package.st | 1 - .../CommentsToTestsTest.class.st | 61 --- src/DrTests-CommentsToTests-Tests/package.st | 1 - .../DTCommentTestConfiguration.class.st | 25 - .../DTCommentToTestPlugin.class.st | 108 ----- .../DTCommentToTestResult.class.st | 55 --- src/DrTests-CommentsToTests/package.st | 1 - .../DTRFTPlugin.class.st | 80 ---- .../DTRTFConfiguration.class.st | 10 - .../DTRTFResult.class.st | 46 -- .../RottenTestsSet.extension.st | 28 -- src/DrTests-RottenGreenTestsFinder/package.st | 1 - .../DTCoverageMockTest.class.st | 37 -- .../MockForCoverage.class.st | 30 -- .../package.st | 1 - .../DTCoverageCollectorTest.class.st | 36 -- .../DTTestCoverageTest.class.st | 134 ------ src/DrTests-TestCoverage-Tests/package.st | 1 - .../CompiledMethod.extension.st | 6 - .../DTCoverageCollector.class.st | 46 -- .../DTCoverageResult.class.st | 32 -- .../DTTestCoverageConfiguration.class.st | 18 - .../DTTestCoveragePlugin.class.st | 152 ------ .../DTTestCoverageResult.class.st | 90 ---- src/DrTests-TestCoverage/package.st | 1 - .../DTCoveragePluginPresenterTest.class.st | 39 -- .../DTFilterableListPresenterTest.class.st | 61 --- src/DrTests-Tests/DTMockPlugin.class.st | 81 ---- src/DrTests-Tests/DTMockPluginResult.class.st | 32 -- src/DrTests-Tests/DTMockPluginTest.class.st | 22 - .../DrTestsTestRunnerTest.class.st | 80 ---- .../DrTestsTestRunnerUITest.class.st | 26 - src/DrTests-Tests/DrTestsUITest.class.st | 163 ------- .../MockDTCoveragePluginPresenter.class.st | 32 -- src/DrTests-Tests/package.st | 1 - .../DTTestProfilingTest.class.st | 101 ---- src/DrTests-TestsProfiling-Tests/package.st | 1 - .../DTTestCaseProfilingData.class.st | 76 --- .../DTTestsProfilerVisitor.class.st | 45 -- .../DTTestsProfilingPlugin.class.st | 67 --- .../DTTestsProfilingResult.class.st | 104 ---- src/DrTests-TestsProfiling/package.st | 1 - .../DTDebugTestCommand.class.st | 29 -- .../DTErrorResultType.class.st | 26 - .../DTExpectedFailureResultType.class.st | 26 - .../DTFailResultType.class.st | 26 - .../DTPassResultType.class.st | 26 - .../DTReRunConfiguration.extension.st | 6 - .../DTRerunCommand.class.st | 22 - .../DTSkippedResultType.class.st | 26 - .../DTTestLeafNode.class.st | 32 -- .../DTTestResultType.class.st | 90 ---- .../DTTestsRunnerConfiguration.class.st | 22 - .../DTTestsRunnerPlugin.class.st | 177 ------- .../DTTestsRunnerResult.class.st | 197 -------- .../DTUnexpectedPassResultType.class.st | 27 -- .../DrTestsPlugin.extension.st | 12 - src/DrTests-TestsRunner/TestCase.extension.st | 33 -- src/DrTests-TestsRunner/package.st | 1 - src/DrTests/AbstractDrTestsPresenter.class.st | 204 -------- src/DrTests/ClassDescription.extension.st | 10 - src/DrTests/CompiledMethod.extension.st | 18 - src/DrTests/DTAbstractTreeNode.class.st | 55 --- .../DTBrowseSelectedItemCommand.class.st | 29 -- src/DrTests/DTCommand.class.st | 21 - .../DTCoveragePluginPresenter.class.st | 162 ------- src/DrTests/DTDefaultPluginPresenter.class.st | 448 ------------------ .../DTFilterableListPresenter.class.st | 249 ---------- .../DTFilterableTreePresenter.class.st | 256 ---------- .../DTInspectSelectedItemCommand.class.st | 22 - src/DrTests/DTLeafResultCommand.class.st | 21 - src/DrTests/DTLeavesCollector.class.st | 43 -- src/DrTests/DTMiddleListCommand.class.st | 22 - src/DrTests/DTNullPluginPresenter.class.st | 17 - src/DrTests/DTPackagesBrowseCommand.class.st | 22 - src/DrTests/DTPackagesCommand.class.st | 16 - src/DrTests/DTPackagesInspectCommand.class.st | 22 - .../DTPackagesSelectAllCommand.class.st | 22 - .../DTPackagesSelectNoneCommand.class.st | 22 - src/DrTests/DTPluginConfiguration.class.st | 81 ---- src/DrTests/DTPluginResult.class.st | 38 -- src/DrTests/DTReRunConfiguration.class.st | 50 -- src/DrTests/DTResultBrowseCommand.class.st | 26 - src/DrTests/DTResultCommand.class.st | 21 - src/DrTests/DTResultTreeView.class.st | 49 -- src/DrTests/DTResultsTreeVisitor.class.st | 25 - src/DrTests/DTStatusUpdate.class.st | 33 -- src/DrTests/DTStyleContributor.class.st | 38 -- src/DrTests/DTTreeLeafNode.class.st | 68 --- src/DrTests/DTTreeNode.class.st | 167 ------- src/DrTests/DTUpdateResults.class.st | 26 - src/DrTests/DrTests.class.st | 321 ------------- src/DrTests/DrTestsPlugin.class.st | 194 -------- src/DrTests/MiniDrTests.class.st | 113 ----- src/DrTests/TestCase.extension.st | 18 - src/DrTests/package.st | 1 - 97 files changed, 5706 deletions(-) delete mode 100644 src/BaselineOfDrTests/BaselineOfDrTests.class.st delete mode 100644 src/BaselineOfDrTests/package.st delete mode 100644 src/DrTests-CommentsToTests-Tests/CommentsToTestsTest.class.st delete mode 100644 src/DrTests-CommentsToTests-Tests/package.st delete mode 100644 src/DrTests-CommentsToTests/DTCommentTestConfiguration.class.st delete mode 100644 src/DrTests-CommentsToTests/DTCommentToTestPlugin.class.st delete mode 100644 src/DrTests-CommentsToTests/DTCommentToTestResult.class.st delete mode 100644 src/DrTests-CommentsToTests/package.st delete mode 100644 src/DrTests-RottenGreenTestsFinder/DTRFTPlugin.class.st delete mode 100644 src/DrTests-RottenGreenTestsFinder/DTRTFConfiguration.class.st delete mode 100644 src/DrTests-RottenGreenTestsFinder/DTRTFResult.class.st delete mode 100644 src/DrTests-RottenGreenTestsFinder/RottenTestsSet.extension.st delete mode 100644 src/DrTests-RottenGreenTestsFinder/package.st delete mode 100644 src/DrTests-TestCoverage-Tests-Mocks/DTCoverageMockTest.class.st delete mode 100644 src/DrTests-TestCoverage-Tests-Mocks/MockForCoverage.class.st delete mode 100644 src/DrTests-TestCoverage-Tests-Mocks/package.st delete mode 100644 src/DrTests-TestCoverage-Tests/DTCoverageCollectorTest.class.st delete mode 100644 src/DrTests-TestCoverage-Tests/DTTestCoverageTest.class.st delete mode 100644 src/DrTests-TestCoverage-Tests/package.st delete mode 100644 src/DrTests-TestCoverage/CompiledMethod.extension.st delete mode 100644 src/DrTests-TestCoverage/DTCoverageCollector.class.st delete mode 100644 src/DrTests-TestCoverage/DTCoverageResult.class.st delete mode 100644 src/DrTests-TestCoverage/DTTestCoverageConfiguration.class.st delete mode 100644 src/DrTests-TestCoverage/DTTestCoveragePlugin.class.st delete mode 100644 src/DrTests-TestCoverage/DTTestCoverageResult.class.st delete mode 100644 src/DrTests-TestCoverage/package.st delete mode 100644 src/DrTests-Tests/DTCoveragePluginPresenterTest.class.st delete mode 100644 src/DrTests-Tests/DTFilterableListPresenterTest.class.st delete mode 100644 src/DrTests-Tests/DTMockPlugin.class.st delete mode 100644 src/DrTests-Tests/DTMockPluginResult.class.st delete mode 100644 src/DrTests-Tests/DTMockPluginTest.class.st delete mode 100644 src/DrTests-Tests/DrTestsTestRunnerTest.class.st delete mode 100644 src/DrTests-Tests/DrTestsTestRunnerUITest.class.st delete mode 100644 src/DrTests-Tests/DrTestsUITest.class.st delete mode 100644 src/DrTests-Tests/MockDTCoveragePluginPresenter.class.st delete mode 100644 src/DrTests-Tests/package.st delete mode 100644 src/DrTests-TestsProfiling-Tests/DTTestProfilingTest.class.st delete mode 100644 src/DrTests-TestsProfiling-Tests/package.st delete mode 100644 src/DrTests-TestsProfiling/DTTestCaseProfilingData.class.st delete mode 100644 src/DrTests-TestsProfiling/DTTestsProfilerVisitor.class.st delete mode 100644 src/DrTests-TestsProfiling/DTTestsProfilingPlugin.class.st delete mode 100644 src/DrTests-TestsProfiling/DTTestsProfilingResult.class.st delete mode 100644 src/DrTests-TestsProfiling/package.st delete mode 100644 src/DrTests-TestsRunner/DTDebugTestCommand.class.st delete mode 100644 src/DrTests-TestsRunner/DTErrorResultType.class.st delete mode 100644 src/DrTests-TestsRunner/DTExpectedFailureResultType.class.st delete mode 100644 src/DrTests-TestsRunner/DTFailResultType.class.st delete mode 100644 src/DrTests-TestsRunner/DTPassResultType.class.st delete mode 100644 src/DrTests-TestsRunner/DTReRunConfiguration.extension.st delete mode 100644 src/DrTests-TestsRunner/DTRerunCommand.class.st delete mode 100644 src/DrTests-TestsRunner/DTSkippedResultType.class.st delete mode 100644 src/DrTests-TestsRunner/DTTestLeafNode.class.st delete mode 100644 src/DrTests-TestsRunner/DTTestResultType.class.st delete mode 100644 src/DrTests-TestsRunner/DTTestsRunnerConfiguration.class.st delete mode 100644 src/DrTests-TestsRunner/DTTestsRunnerPlugin.class.st delete mode 100644 src/DrTests-TestsRunner/DTTestsRunnerResult.class.st delete mode 100644 src/DrTests-TestsRunner/DTUnexpectedPassResultType.class.st delete mode 100644 src/DrTests-TestsRunner/DrTestsPlugin.extension.st delete mode 100644 src/DrTests-TestsRunner/TestCase.extension.st delete mode 100644 src/DrTests-TestsRunner/package.st delete mode 100644 src/DrTests/AbstractDrTestsPresenter.class.st delete mode 100644 src/DrTests/ClassDescription.extension.st delete mode 100644 src/DrTests/CompiledMethod.extension.st delete mode 100644 src/DrTests/DTAbstractTreeNode.class.st delete mode 100644 src/DrTests/DTBrowseSelectedItemCommand.class.st delete mode 100644 src/DrTests/DTCommand.class.st delete mode 100644 src/DrTests/DTCoveragePluginPresenter.class.st delete mode 100644 src/DrTests/DTDefaultPluginPresenter.class.st delete mode 100644 src/DrTests/DTFilterableListPresenter.class.st delete mode 100644 src/DrTests/DTFilterableTreePresenter.class.st delete mode 100644 src/DrTests/DTInspectSelectedItemCommand.class.st delete mode 100644 src/DrTests/DTLeafResultCommand.class.st delete mode 100644 src/DrTests/DTLeavesCollector.class.st delete mode 100644 src/DrTests/DTMiddleListCommand.class.st delete mode 100644 src/DrTests/DTNullPluginPresenter.class.st delete mode 100644 src/DrTests/DTPackagesBrowseCommand.class.st delete mode 100644 src/DrTests/DTPackagesCommand.class.st delete mode 100644 src/DrTests/DTPackagesInspectCommand.class.st delete mode 100644 src/DrTests/DTPackagesSelectAllCommand.class.st delete mode 100644 src/DrTests/DTPackagesSelectNoneCommand.class.st delete mode 100644 src/DrTests/DTPluginConfiguration.class.st delete mode 100644 src/DrTests/DTPluginResult.class.st delete mode 100644 src/DrTests/DTReRunConfiguration.class.st delete mode 100644 src/DrTests/DTResultBrowseCommand.class.st delete mode 100644 src/DrTests/DTResultCommand.class.st delete mode 100644 src/DrTests/DTResultTreeView.class.st delete mode 100644 src/DrTests/DTResultsTreeVisitor.class.st delete mode 100644 src/DrTests/DTStatusUpdate.class.st delete mode 100644 src/DrTests/DTStyleContributor.class.st delete mode 100644 src/DrTests/DTTreeLeafNode.class.st delete mode 100644 src/DrTests/DTTreeNode.class.st delete mode 100644 src/DrTests/DTUpdateResults.class.st delete mode 100644 src/DrTests/DrTests.class.st delete mode 100644 src/DrTests/DrTestsPlugin.class.st delete mode 100644 src/DrTests/MiniDrTests.class.st delete mode 100644 src/DrTests/TestCase.extension.st delete mode 100644 src/DrTests/package.st diff --git a/src/BaselineOfDrTests/BaselineOfDrTests.class.st b/src/BaselineOfDrTests/BaselineOfDrTests.class.st deleted file mode 100644 index 94033fa27ea..00000000000 --- a/src/BaselineOfDrTests/BaselineOfDrTests.class.st +++ /dev/null @@ -1,45 +0,0 @@ -Class { - #name : 'BaselineOfDrTests', - #superclass : 'BaselineOf', - #category : 'BaselineOfDrTests', - #package : 'BaselineOfDrTests' -} - -{ #category : 'baselines' } -BaselineOfDrTests >> baseline: spec [ - - spec - for: #common - do: [ - spec - package: 'DrTests'; - package: 'Coverage'; - package: 'DrTests-TestsRunner' with: [ spec requires: #('DrTests') ]; - package: 'DrTests-TestCoverage' with: [ spec requires: #('DrTests' 'Coverage') ]; - package: 'DrTests-TestsProfiling' with: [ spec requires: #('DrTests') ]; - package: 'DrTests-Tests' with: [ spec requires: #('DrTests' 'DrTests-TestsRunner' 'DrTests-TestCoverage-Tests-Mocks') ]; - package: 'DrTests-TestCoverage-Tests' with: [ spec requires: #('DrTests-TestCoverage' 'DrTests-TestCoverage-Tests-Mocks') ]; - package: 'DrTests-TestsProfiling-Tests' with: [ spec requires: #('DrTests-TestsProfiling') ]; - package: 'DrTests-TestCoverage-Tests-Mocks' with: [ spec requires: #('DrTests-TestCoverage') ]; - package: 'DrTests-CommentsToTests' with: [ spec requires: #('DrTests' 'DrTests-TestsRunner') ]; - package: 'DrTests-CommentsToTests-Tests' with: [ spec requires: #('DrTests-CommentsToTests') ]. - self rottenTestsFinder: spec. - spec package: 'DrTests-RottenGreenTestsFinder' with: [ spec requires: #('rotten-tests-finder') ]. ] -] - -{ #category : 'actions' } -BaselineOfDrTests >> postload: loader package: packageSpec [ - - self tools register: DrTests as: #testRunner -] - -{ #category : 'baselines' } -BaselineOfDrTests >> rottenTestsFinder: spec [ - - spec - package: 'RottenTestsFinder'; - package: 'RottenTestsFinder-FakeTests' with: [ spec requires: #('RottenTestsFinder') ]; - package: 'RottenTestsFinder-Tests' with: [ spec requires: #('RottenTestsFinder') ]; - group: 'rotten-tests-finder' with: #('RottenTestsFinder' 'RottenTestsFinder-FakeTests' 'RottenTestsFinder-Tests'). - -] diff --git a/src/BaselineOfDrTests/package.st b/src/BaselineOfDrTests/package.st deleted file mode 100644 index 8b076cdcfe8..00000000000 --- a/src/BaselineOfDrTests/package.st +++ /dev/null @@ -1 +0,0 @@ -Package { #name : 'BaselineOfDrTests' } diff --git a/src/DrTests-CommentsToTests-Tests/CommentsToTestsTest.class.st b/src/DrTests-CommentsToTests-Tests/CommentsToTestsTest.class.st deleted file mode 100644 index d8c6ed5607f..00000000000 --- a/src/DrTests-CommentsToTests-Tests/CommentsToTestsTest.class.st +++ /dev/null @@ -1,61 +0,0 @@ -" -A DrTestsUITest is a test class for testing the behavior of DrTests-CommentsToTestsTest -" -Class { - #name : 'CommentsToTestsTest', - #superclass : 'TestCase', - #category : 'DrTests-CommentsToTests-Tests-Base', - #package : 'DrTests-CommentsToTests-Tests', - #tag : 'Base' -} - -{ #category : 'tests' } -CommentsToTestsTest >> testCommentWithFailure [ - "(1+3)>>>5" - - | docComment commentTestCase | - - docComment := thisContext method ast pharoDocCommentNodes first. - commentTestCase := CommentTestCase for: docComment. - - self should: [commentTestCase testIt] raise: TestFailure -] - -{ #category : 'tests' } -CommentsToTestsTest >> testCommentWithSyntaxError [ - "(1+)>>>5" - - | docComment commentTestCase | - - docComment := thisContext method ast pharoDocCommentNodes first. - commentTestCase := CommentTestCase for: docComment. - - self should: [commentTestCase testIt] raise: OCCodeError -] - -{ #category : 'tests' } -CommentsToTestsTest >> testErrorComment [ - "(1+3)+6/0>>>4" - - | docComment commentTestCase | - - docComment := thisContext method ast pharoDocCommentNodes first. - commentTestCase := CommentTestCase for: docComment. - - self should: [commentTestCase testIt] raise: Error -] - -{ #category : 'tests' } -CommentsToTestsTest >> testSimpleComment [ - "(1+3)>>>4" - - | docComment commentTestCase value | - - docComment := thisContext method ast pharoDocCommentNodes first. - commentTestCase := CommentTestCase for: docComment. - value := commentTestCase evaluate. - - self - assert: value key - equals: value value -] diff --git a/src/DrTests-CommentsToTests-Tests/package.st b/src/DrTests-CommentsToTests-Tests/package.st deleted file mode 100644 index 11caaba24bf..00000000000 --- a/src/DrTests-CommentsToTests-Tests/package.st +++ /dev/null @@ -1 +0,0 @@ -Package { #name : 'DrTests-CommentsToTests-Tests' } diff --git a/src/DrTests-CommentsToTests/DTCommentTestConfiguration.class.st b/src/DrTests-CommentsToTests/DTCommentTestConfiguration.class.st deleted file mode 100644 index 211a3427ed9..00000000000 --- a/src/DrTests-CommentsToTests/DTCommentTestConfiguration.class.st +++ /dev/null @@ -1,25 +0,0 @@ -" -I know the items to create a testSuite that will be analysed by a DrTestsPlugin. -" -Class { - #name : 'DTCommentTestConfiguration', - #superclass : 'DTPluginConfiguration', - #category : 'DrTests-CommentsToTests-Base', - #package : 'DrTests-CommentsToTests', - #tag : 'Base' -} - -{ #category : 'converting' } -DTCommentTestConfiguration >> asTestSuite [ - - | suite classes methods | - suite := TestSuite named: 'Test Generated From Comments'. - classes := self items addAll: (self items collect: [ :each | each class ]); yourself. - methods := classes flatCollect: [ :each | each methods ]. - "keep only methods defined in a selected package or methods whose classes are defined in a selected package." - methods := methods select: [ :m | (packagesSelected includes: m package) or: [ packagesSelected includes: m origin package ] ]. - methods do: [ :method | - method pharoDocCommentNodes do: [ :docComment | - suite addTest: (CommentTestCase for: docComment) ] ]. - ^ suite -] diff --git a/src/DrTests-CommentsToTests/DTCommentToTestPlugin.class.st b/src/DrTests-CommentsToTests/DTCommentToTestPlugin.class.st deleted file mode 100644 index c8f4e549fda..00000000000 --- a/src/DrTests-CommentsToTests/DTCommentToTestPlugin.class.st +++ /dev/null @@ -1,108 +0,0 @@ -" -I am a DrTestPlugin. -I create tests from executable comments and run these tests. -" -Class { - #name : 'DTCommentToTestPlugin', - #superclass : 'DrTestsPlugin', - #category : 'DrTests-CommentsToTests-Base', - #package : 'DrTests-CommentsToTests', - #tag : 'Base' -} - -{ #category : 'api - accessing' } -DTCommentToTestPlugin class >> pluginName [ - "The name of the plugin to be displayed in DrTests UI." - ^ 'Executable comments checker' -] - -{ #category : 'api - accessing' } -DTCommentToTestPlugin class >> pluginResultClass [ - ^ DTCommentToTestResult -] - -{ #category : 'api - accessing' } -DTCommentToTestPlugin class >> weight [ - "The lighter is a plugin, the higher it is displayed in the drop list for plugin selection." - ^ 10 -] - -{ #category : 'configuration building' } -DTCommentToTestPlugin >> buildConfigurationFrom: aDrTests [ - ^ DTCommentTestConfiguration items: aDrTests selectedItems packages: aDrTests packagesSelected -] - -{ #category : 'api' } -DTCommentToTestPlugin >> firstListLabel [ - ^ 'Packages' -] - -{ #category : 'api' } -DTCommentToTestPlugin >> itemsToBeAnalysedFor: packagesSelected [ - - "note `asSet` is used to avoid duplication if a class is defined/extended in more than one package" - - ^ packagesSelected asSet flatCollect: [ :package | - package definedOrExtendedClasses select: [ :class | - class hasDocComment or: [ class class hasDocComment ] ] ] -] - -{ #category : 'api' } -DTCommentToTestPlugin >> packagesAvailableForAnalysis [ - - ^ self packageOrganizer packages select: [ :p | p definedClasses anySatisfy: [ :c | c isTestCase not ] ] -] - -{ #category : 'accessing' } -DTCommentToTestPlugin >> pragmaForResultTrees [ - ^ #'dtCommentToTestResultTreeNamed:order:' -] - -{ #category : 'api' } -DTCommentToTestPlugin >> resultButtonHelp [ - ^ 'Browse the test selected in the result list.' -] - -{ #category : 'api' } -DTCommentToTestPlugin >> runForConfiguration: aDTpluginConfiguration [ - ^ self pluginResultClass new - testResults: (self runTestSuites: {aDTpluginConfiguration asTestSuite}); - yourself -] - -{ #category : 'api' } -DTCommentToTestPlugin >> runSuite: aTestSuite withResult: aResult [ - aTestSuite - when: TestAnnouncement - do: [ :testAnnouncement | - self announceStatusChanged: ('Running test {1}.' format: {testAnnouncement test asString}) ] - for: self. - [ aTestSuite run: aResult ] - ensure: [ aTestSuite unsubscribe: TestAnnouncement ] -] - -{ #category : 'api' } -DTCommentToTestPlugin >> runTestSuites: testSuites [ - | result | - result := TestAsserter classForTestResult new. - CurrentExecutionEnvironment - runTestsBy: [ testSuites - do: [ :testSuite | self runSuite: testSuite withResult: result ] - displayingProgress: 'Running Tests' ]. - ^ result -] - -{ #category : 'api' } -DTCommentToTestPlugin >> secondListLabel [ - ^ 'Classes' -] - -{ #category : 'api' } -DTCommentToTestPlugin >> startButtonHelp [ - ^ 'Run selected tests.' -] - -{ #category : 'api' } -DTCommentToTestPlugin >> startButtonLabel [ - ^ 'Run Tests' translated -] diff --git a/src/DrTests-CommentsToTests/DTCommentToTestResult.class.st b/src/DrTests-CommentsToTests/DTCommentToTestResult.class.st deleted file mode 100644 index f571239e879..00000000000 --- a/src/DrTests-CommentsToTests/DTCommentToTestResult.class.st +++ /dev/null @@ -1,55 +0,0 @@ -" -I build a tree with the testsResult created by comments listed in groups: -- Errors -- Failures -- Passed test -I am used in DrTestsUI to show the results in a orderly manner. -" -Class { - #name : 'DTCommentToTestResult', - #superclass : 'DTPluginResult', - #instVars : [ - 'testsResult' - ], - #category : 'DrTests-CommentsToTests-Base', - #package : 'DrTests-CommentsToTests', - #tag : 'Base' -} - -{ #category : 'accessing' } -DTCommentToTestResult >> buildTreeForUI [ - - - ^ DTTreeNode new - subResults: { - (DTTreeNode new - name: 'Errors'; - subResults: (self testResults errors collect: [:each | each asResultForDrTest ]); - startExpanded; - displayColorIfNotEmpty: TestResult defaultColorBackGroundForErrorTest; - yourself). - (DTTreeNode new - name: 'Failures'; - subResults: (self testResults failures - collect: [:each | each asResultForDrTest] - as: OrderedCollection); - startExpanded; - displayColorIfNotEmpty: TestResult defaultColorBackGroundForFailureTest; - yourself). - (DTTreeNode new - name: 'Passed tests'; - subResults: (self testResults passed collect: [:each | each asResultForDrTest] ); - displayColorIfNotEmpty: TestResult defaultColorBackGroundForPassingTest; - yourself) }; - yourself -] - -{ #category : 'accessing' } -DTCommentToTestResult >> testResults [ - ^ testsResult -] - -{ #category : 'accessing' } -DTCommentToTestResult >> testResults: anObject [ - testsResult := anObject -] diff --git a/src/DrTests-CommentsToTests/package.st b/src/DrTests-CommentsToTests/package.st deleted file mode 100644 index 1500129ecd9..00000000000 --- a/src/DrTests-CommentsToTests/package.st +++ /dev/null @@ -1 +0,0 @@ -Package { #name : 'DrTests-CommentsToTests' } diff --git a/src/DrTests-RottenGreenTestsFinder/DTRFTPlugin.class.st b/src/DrTests-RottenGreenTestsFinder/DTRFTPlugin.class.st deleted file mode 100644 index d0a4790edf2..00000000000 --- a/src/DrTests-RottenGreenTestsFinder/DTRFTPlugin.class.st +++ /dev/null @@ -1,80 +0,0 @@ -" -I am plugin implementing RottenGreenTestsFinder in DrTests -" -Class { - #name : 'DTRFTPlugin', - #superclass : 'DrTestsPlugin', - #category : 'DrTests-RottenGreenTestsFinder-Base', - #package : 'DrTests-RottenGreenTestsFinder', - #tag : 'Base' -} - -{ #category : 'api - accessing' } -DTRFTPlugin class >> pluginName [ - "The name of the plugin to be displayed in DrTests UI." - ^ 'Rotten green tests finder' -] - -{ #category : 'api - accessing' } -DTRFTPlugin class >> pluginResultClass [ - "Returns the class that this plugin instantiate for its results." - ^ DTRTFResult -] - -{ #category : 'api - accessing' } -DTRFTPlugin class >> weight [ - "The lighter is a plugin, the higher it is displayed in the drop list for plugin selection." - ^ 7 -] - -{ #category : 'analyze' } -DTRFTPlugin >> analyse: aTestClass [ - - ^ RottenTestsFinder analyze: aTestClass -] - -{ #category : 'api' } -DTRFTPlugin >> analyseTestFrom: aDTpluginConfiguration [ - |result| - result := self pluginResultClass new. - aDTpluginConfiguration items do: [ :testClass | - result add: (self analyse: testClass) ]. - ^ result -] - -{ #category : 'accessing' } -DTRFTPlugin >> firstListLabel [ - ^ 'Packages' -] - -{ #category : 'accessing' } -DTRFTPlugin >> pragmaForResultTrees [ - "Returns the selector of the pragma to gather result trees." - ^ 'dtTestRTFResultTreeNamed:order:' -] - -{ #category : 'api' } -DTRFTPlugin >> resultButtonHelp [ - ^ 'Browse the test selected in the results list.' translated -] - -{ #category : 'api' } -DTRFTPlugin >> runForConfiguration: aDTpluginConfiguration [ - - ^ self analyseTestFrom: aDTpluginConfiguration -] - -{ #category : 'accessing' } -DTRFTPlugin >> secondListLabel [ - ^ 'Tests Cases' -] - -{ #category : 'api' } -DTRFTPlugin >> startButtonHelp [ - ^ 'Run Tests' translated -] - -{ #category : 'api' } -DTRFTPlugin >> startButtonLabel [ - ^ 'Run tests selected.' translated -] diff --git a/src/DrTests-RottenGreenTestsFinder/DTRTFConfiguration.class.st b/src/DrTests-RottenGreenTestsFinder/DTRTFConfiguration.class.st deleted file mode 100644 index 16be2811f96..00000000000 --- a/src/DrTests-RottenGreenTestsFinder/DTRTFConfiguration.class.st +++ /dev/null @@ -1,10 +0,0 @@ -" -I am a configuration for Rotten green tests finder for DrTests -" -Class { - #name : 'DTRTFConfiguration', - #superclass : 'DTPluginConfiguration', - #category : 'DrTests-RottenGreenTestsFinder-Base', - #package : 'DrTests-RottenGreenTestsFinder', - #tag : 'Base' -} diff --git a/src/DrTests-RottenGreenTestsFinder/DTRTFResult.class.st b/src/DrTests-RottenGreenTestsFinder/DTRTFResult.class.st deleted file mode 100644 index b9665f682df..00000000000 --- a/src/DrTests-RottenGreenTestsFinder/DTRTFResult.class.st +++ /dev/null @@ -1,46 +0,0 @@ -Class { - #name : 'DTRTFResult', - #superclass : 'DTPluginResult', - #instVars : [ - 'result' - ], - #category : 'DrTests-RottenGreenTestsFinder-Base', - #package : 'DrTests-RottenGreenTestsFinder', - #tag : 'Base' -} - -{ #category : 'adding' } -DTRTFResult >> add: aRottenTestsSet [ - - self result mergeWith: aRottenTestsSet -] - -{ #category : 'accessing' } -DTRTFResult >> addRottenTest: aRottenTest [ - - self rottenTests add: aRottenTest -] - -{ #category : 'accessing' } -DTRTFResult >> buildTreeForUI [ - "build the UI for presenting result" - - ^ DTTreeNode new subResults: { (DTTreeNode new - name: 'Rotten green tests'; - subResults: - (self rottenTests collect: [ :m | m compiledMethod asResultForDrTest ]); - yourself) } -] - -{ #category : 'accessing' } -DTRTFResult >> result [ - - ^ result ifNil: [ result := RottenTestsSet new ] -] - -{ #category : 'accessing' } -DTRTFResult >> rottenTests [ - - ^ (self result rottenTests ifNil: [ result := RottenTestsSet ]) - asOrderedCollection -] diff --git a/src/DrTests-RottenGreenTestsFinder/RottenTestsSet.extension.st b/src/DrTests-RottenGreenTestsFinder/RottenTestsSet.extension.st deleted file mode 100644 index 54c78ea1fa1..00000000000 --- a/src/DrTests-RottenGreenTestsFinder/RottenTestsSet.extension.st +++ /dev/null @@ -1,28 +0,0 @@ -Extension { #name : 'RottenTestsSet' } - -{ #category : '*DrTests-RottenGreenTestsFinder' } -RottenTestsSet >> addToTestRunCount: anInteger [ - - testsRunCount := self testsRunCount + anInteger -] - -{ #category : '*DrTests-RottenGreenTestsFinder' } -RottenTestsSet >> addToTestsVisitedCount: anInteger [ - - testsVisitedCount := self testsVisitedCount + anInteger -] - -{ #category : '*DrTests-RottenGreenTestsFinder' } -RottenTestsSet >> mergeWith: aRottenTestsSet [ - - self - addAll: aRottenTestsSet rottenTests; - addToTestsVisitedCount: aRottenTestsSet testsVisitedCount; - addToTestRunCount: aRottenTestsSet testsRunCount -] - -{ #category : '*DrTests-RottenGreenTestsFinder' } -RottenTestsSet >> testsRunCount [ - - ^ testsRunCount ifNil: [ testsRunCount := 0 ] -] diff --git a/src/DrTests-RottenGreenTestsFinder/package.st b/src/DrTests-RottenGreenTestsFinder/package.st deleted file mode 100644 index c38f46fc234..00000000000 --- a/src/DrTests-RottenGreenTestsFinder/package.st +++ /dev/null @@ -1 +0,0 @@ -Package { #name : 'DrTests-RottenGreenTestsFinder' } diff --git a/src/DrTests-TestCoverage-Tests-Mocks/DTCoverageMockTest.class.st b/src/DrTests-TestCoverage-Tests-Mocks/DTCoverageMockTest.class.st deleted file mode 100644 index 06bf48d2de5..00000000000 --- a/src/DrTests-TestCoverage-Tests-Mocks/DTCoverageMockTest.class.st +++ /dev/null @@ -1,37 +0,0 @@ -Class { - #name : 'DTCoverageMockTest', - #superclass : 'TestCase', - #instVars : [ - 'mockObj' - ], - #category : 'DrTests-TestCoverage-Tests-Mocks-Base', - #package : 'DrTests-TestCoverage-Tests-Mocks', - #tag : 'Base' -} - -{ #category : 'running' } -DTCoverageMockTest >> setUp [ - - super setUp. - mockObj := MockForCoverage new -] - -{ #category : 'running' } -DTCoverageMockTest >> testMethod1forMock [ - - self assert: mockObj method1ForMock equals: 2 -] - -{ #category : 'running' } -DTCoverageMockTest >> testMethod2forMock [ - - self - assert: 5 - equals: 5 -] - -{ #category : 'running' } -DTCoverageMockTest >> testMethod3forMock [ - - self assert: (mockObj method3ForMockWithConditional: 2 ) equals: 0 -] diff --git a/src/DrTests-TestCoverage-Tests-Mocks/MockForCoverage.class.st b/src/DrTests-TestCoverage-Tests-Mocks/MockForCoverage.class.st deleted file mode 100644 index 31714a25836..00000000000 --- a/src/DrTests-TestCoverage-Tests-Mocks/MockForCoverage.class.st +++ /dev/null @@ -1,30 +0,0 @@ -" -A mock class with methods used for testing the coverage plugin of DrTest -" -Class { - #name : 'MockForCoverage', - #superclass : 'Object', - #category : 'DrTests-TestCoverage-Tests-Mocks-Mocking', - #package : 'DrTests-TestCoverage-Tests-Mocks', - #tag : 'Mocking' -} - -{ #category : 'sample methods' } -MockForCoverage >> method1ForMock [ - - ^ 1 + 1 -] - -{ #category : 'sample methods' } -MockForCoverage >> method2ForMock: anObject [ - - ^ 1 + anObject -] - -{ #category : 'sample methods' } -MockForCoverage >> method3ForMockWithConditional: anInteger [ - - anInteger > 5 - ifTrue: [ ^ 1 ] - ifFalse: [ ^ 0 ] -] diff --git a/src/DrTests-TestCoverage-Tests-Mocks/package.st b/src/DrTests-TestCoverage-Tests-Mocks/package.st deleted file mode 100644 index 5d29f8b6714..00000000000 --- a/src/DrTests-TestCoverage-Tests-Mocks/package.st +++ /dev/null @@ -1 +0,0 @@ -Package { #name : 'DrTests-TestCoverage-Tests-Mocks' } diff --git a/src/DrTests-TestCoverage-Tests/DTCoverageCollectorTest.class.st b/src/DrTests-TestCoverage-Tests/DTCoverageCollectorTest.class.st deleted file mode 100644 index 9fd7f66a7a5..00000000000 --- a/src/DrTests-TestCoverage-Tests/DTCoverageCollectorTest.class.st +++ /dev/null @@ -1,36 +0,0 @@ -Class { - #name : 'DTCoverageCollectorTest', - #superclass : 'TestCase', - #category : 'DrTests-TestCoverage-Tests', - #package : 'DrTests-TestCoverage-Tests' -} - -{ #category : 'tests' } -DTCoverageCollectorTest >> testResultIsADTCoverageResultClass [ - - | cov res | - cov := DTCoverageCollector new. - cov methods: { (MockForCoverage >> #method1ForMock) . (MockForCoverage >> #method2ForMock:) }. - res := cov runOn: [ |mockClass| mockClass := MockForCoverage new. mockClass method1ForMock ]. - - self assert: res class equals: DTCoverageResult . -] - -{ #category : 'tests' } -DTCoverageCollectorTest >> testReturnCoverageResult [ - - | cov res | - cov := DTCoverageCollector new. - cov methods: { - (MockForCoverage >> #method1ForMock). - (MockForCoverage >> #method2ForMock:). - (MockForCoverage >> #method3ForMockWithConditional:)}. - res := cov runOn: [ - | mockClass | - mockClass := MockForCoverage new. - mockClass method1ForMock. - mockClass method3ForMockWithConditional: 0 ]. - - self assert: res methods size equals: 2. - self assert: res partiallyCoveredMethods size equals: 1 -] diff --git a/src/DrTests-TestCoverage-Tests/DTTestCoverageTest.class.st b/src/DrTests-TestCoverage-Tests/DTTestCoverageTest.class.st deleted file mode 100644 index 0370c8f902f..00000000000 --- a/src/DrTests-TestCoverage-Tests/DTTestCoverageTest.class.st +++ /dev/null @@ -1,134 +0,0 @@ -Class { - #name : 'DTTestCoverageTest', - #superclass : 'TestCase', - #instVars : [ - 'plugin', - 'package', - 'pluginConfiguration' - ], - #category : 'DrTests-TestCoverage-Tests', - #package : 'DrTests-TestCoverage-Tests' -} - -{ #category : 'running' } -DTTestCoverageTest >> setUp [ - - super setUp. - package := self packageOrganizer packageNamed: 'DrTests-TestCoverage-Tests-Mocks'. - "The test classes are in the same package as classes under test." - pluginConfiguration := DTPluginConfiguration items: { package } packages: { package }. - plugin := DTTestCoveragePlugin new -] - -{ #category : 'running' } -DTTestCoverageTest >> testCoveragePercentForMock [ - - | result | - result := plugin runForConfiguration: pluginConfiguration. - self assert: result percent class equals: ScaledDecimal -] - -{ #category : 'running' } -DTTestCoverageTest >> testCoverageResultIsAnInstanceOfDTTestCoverageResult [ - - | result | - result := plugin runForConfiguration: pluginConfiguration. - self assert: result class equals: DTTestCoverageResult -] - -{ #category : 'running' } -DTTestCoverageTest >> testDTTestCoverageResultAsResultForDrTests [ - "the packages contains at least one test class" - - | items | - items := plugin packagesAvailableForAnalysis. - self - assert: - (items - allSatisfy: [ :p | p definedClasses anySatisfy: [ :c | c isTestCase ] ]) -] - -{ #category : 'running' } -DTTestCoverageTest >> testDTTestCoverageResultBuildTreeForUIContainsNodes [ - - | resultTree | - resultTree := (plugin runForConfiguration: pluginConfiguration) buildTreeForUI. - self - assert: - (resultTree subResults - allSatisfy: [ :subResult | subResult class = DTTreeNode ]) -] - -{ #category : 'running' } -DTTestCoverageTest >> testDTTestCoverageResultHas2Nodes [ - - | resultTree | - resultTree := (plugin runForConfiguration: pluginConfiguration) buildTreeForUI. - self assert: resultTree subResults size equals: 3 -] - -{ #category : 'improvements' } -DTTestCoverageTest >> testDTTestCoverageResultHasCovered_Uncovered_PartiallyCoveredMethods [ - - | result | - result := plugin runForConfiguration: pluginConfiguration. - self assert: result methodList size equals: 1. - self assert: result partiallyCoveredMethods size equals: 1 . -] - -{ #category : 'running' } -DTTestCoverageTest >> testDTTestCoverageResultTheFirstNodeIsPercent [ - - | resultTree | - resultTree := (plugin runForConfiguration: pluginConfiguration) buildTreeForUI. - self - assert: - ((resultTree subResults at: 1) name - includesSubstring: '% Code Coverage') -] - -{ #category : 'running' } -DTTestCoverageTest >> testDTTestCoverageResultTheSecondNodeSubResultsAreLeafs [ - - | resultTree leafs | - resultTree := (plugin runForConfiguration: pluginConfiguration) buildTreeForUI. - leafs := resultTree subResults at: 2. - self - assert: (leafs subResults allSatisfy: #isLeaf ) -] - -{ #category : 'running' } -DTTestCoverageTest >> testItemsAvailableInTestCoveragePlugin [ - | items | - items := plugin itemsToBeAnalysedFor: package. - self - assert: - (items - allSatisfy: [ :p | p definedClasses anySatisfy: [ :c | c isTestCase not ] ]) -] - -{ #category : 'running' } -DTTestCoverageTest >> testNotExecutedMethodList [ - - | result notExecutedMethodList | - result := plugin runForConfiguration: pluginConfiguration. - notExecutedMethodList := {(MockForCoverage >> #method2ForMock:)}. - self - assert: - (notExecutedMethodList - allSatisfy: [ :expectedNotExecutedMethod | - result methodList - anySatisfy: [ :anyMethod | - anyMethod methodClass = expectedNotExecutedMethod methodClass - and: [ anyMethod selector = expectedNotExecutedMethod selector ] ] ]) -] - -{ #category : 'running' } -DTTestCoverageTest >> testPackagesAvailableInTestCoveragePlugin [ - | items | - items := plugin packagesAvailableForAnalysis. - self - assert: - (items - allSatisfy: [ :p | p definedClasses anySatisfy: [ :c | c isTestCase ] ]) -] diff --git a/src/DrTests-TestCoverage-Tests/package.st b/src/DrTests-TestCoverage-Tests/package.st deleted file mode 100644 index e007d54cb4a..00000000000 --- a/src/DrTests-TestCoverage-Tests/package.st +++ /dev/null @@ -1 +0,0 @@ -Package { #name : 'DrTests-TestCoverage-Tests' } diff --git a/src/DrTests-TestCoverage/CompiledMethod.extension.st b/src/DrTests-TestCoverage/CompiledMethod.extension.st deleted file mode 100644 index 588ba3a3705..00000000000 --- a/src/DrTests-TestCoverage/CompiledMethod.extension.st +++ /dev/null @@ -1,6 +0,0 @@ -Extension { #name : 'CompiledMethod' } - -{ #category : '*DrTests-TestCoverage' } -CompiledMethod >> drTestsName [ - ^ self printString -] diff --git a/src/DrTests-TestCoverage/DTCoverageCollector.class.st b/src/DrTests-TestCoverage/DTCoverageCollector.class.st deleted file mode 100644 index fd3696bc62c..00000000000 --- a/src/DrTests-TestCoverage/DTCoverageCollector.class.st +++ /dev/null @@ -1,46 +0,0 @@ -" -I am a specialized `CoverageCollector` for DrTests. - -I specify some changes to better fit the needs of the DrTests coverage plugin and display the source code in a panel by highlighting the covered lines of code. - -The main change is in `DTCoverageCollector>>#collectResult` where I omit the ""reset"" step. -" -Class { - #name : 'DTCoverageCollector', - #superclass : 'CoverageCollector', - #category : 'DrTests-TestCoverage', - #package : 'DrTests-TestCoverage' -} - -{ #category : 'basic' } -DTCoverageCollector >> basicCollectResult [ - "Collect the results but does not reset the annotations." - - | res | - res := DTCoverageResult new. - res collector: self. - res methods: (methods select: [ :m | m ast hasBeenExecuted ]). - res nodes: IdentitySet new. - nodes do: [ :node | - node hasBeenExecuted ifTrue: [ res nodes add: node ] ]. - res partiallyCoveredMethods: (methods select: [ :meth | - meth ast hasBeenExecuted and: [ (self hasAllNodesCovered: meth) not ] ]). - ^ res -] - -{ #category : 'basic' } -DTCoverageCollector >> collectResult [ - "Collect the results. - This also remaps the methods and NOT resets the annotations." - - self remapMethods. - ^ self basicCollectResult -] - -{ #category : 'precalculations' } -DTCoverageCollector >> hasAllNodesCovered: aMethod [ - - aMethod ast nodesDo: [ :node | - node isSequence ifTrue: [ node hasBeenExecuted ifFalse: [ ^ false ] ] ]. - ^ true -] diff --git a/src/DrTests-TestCoverage/DTCoverageResult.class.st b/src/DrTests-TestCoverage/DTCoverageResult.class.st deleted file mode 100644 index 3e2a8ae8e8e..00000000000 --- a/src/DrTests-TestCoverage/DTCoverageResult.class.st +++ /dev/null @@ -1,32 +0,0 @@ -" -I am a specialized `CoverageResult` for DrTests. -Like my parent: -- I represent the result of a code coverage measurement. -- My instance is produced by `DTCoverageCollector>>#basicCollectResult`. -- I contain the set of covered methods and sequence nodes. - -I add the partiallyCoveredMethods attribute to store the methods that are only partially covered by tests. - -I am used to display the sourceCode panel in DrTest's Coverage plugin. -" -Class { - #name : 'DTCoverageResult', - #superclass : 'CoverageResult', - #instVars : [ - 'partiallyCoveredMethods' - ], - #category : 'DrTests-TestCoverage', - #package : 'DrTests-TestCoverage' -} - -{ #category : 'accessing' } -DTCoverageResult >> partiallyCoveredMethods [ - - ^ partiallyCoveredMethods -] - -{ #category : 'accessing' } -DTCoverageResult >> partiallyCoveredMethods: anObject [ - - partiallyCoveredMethods := anObject -] diff --git a/src/DrTests-TestCoverage/DTTestCoverageConfiguration.class.st b/src/DrTests-TestCoverage/DTTestCoverageConfiguration.class.st deleted file mode 100644 index 44a4d17d454..00000000000 --- a/src/DrTests-TestCoverage/DTTestCoverageConfiguration.class.st +++ /dev/null @@ -1,18 +0,0 @@ -" -I know the items to create a testSuite that will be analysed by a DrTestsPlugin. -" -Class { - #name : 'DTTestCoverageConfiguration', - #superclass : 'DTPluginConfiguration', - #category : 'DrTests-TestCoverage', - #package : 'DrTests-TestCoverage' -} - -{ #category : 'tests' } -DTTestCoverageConfiguration >> testMethods [ - ^ (packagesSelected - flatCollect: - [ :p | p definedClasses select: [ :c | c allSuperclasses includes: TestCase ] ]) - flatCollect: - [ :c | c methods select:[:m| m isTestMethod ] ] -] diff --git a/src/DrTests-TestCoverage/DTTestCoveragePlugin.class.st b/src/DrTests-TestCoverage/DTTestCoveragePlugin.class.st deleted file mode 100644 index c77cf486de8..00000000000 --- a/src/DrTests-TestCoverage/DTTestCoveragePlugin.class.st +++ /dev/null @@ -1,152 +0,0 @@ -" -I am a DrTestPlugin. -I show the percentage of covered methods with tests and show the list of the uncovered methods. -" -Class { - #name : 'DTTestCoveragePlugin', - #superclass : 'DrTestsPlugin', - #instVars : [ - 'methods', - 'testClasses' - ], - #category : 'DrTests-TestCoverage', - #package : 'DrTests-TestCoverage' -} - -{ #category : 'api - accessing' } -DTTestCoveragePlugin class >> pluginName [ - ^ 'Test Coverage' -] - -{ #category : 'api - accessing' } -DTTestCoveragePlugin class >> pluginResultClass [ - ^ DTTestCoverageResult -] - -{ #category : 'api - accessing' } -DTTestCoveragePlugin class >> weight [ - ^ 3 -] - -{ #category : 'api' } -DTTestCoveragePlugin >> allowMiniDrTests [ - ^ true -] - -{ #category : 'api' } -DTTestCoveragePlugin >> allowMultipleSelectionInSecondList [ - ^ false -] - -{ #category : 'api' } -DTTestCoveragePlugin >> defineData: aDTpluginConfiguration [ - - methods := aDTpluginConfiguration items flatCollect: [ :p | - p methods reject: [ :meth | - meth isTestMethod or: [meth methodClass isTestCase] ] ]. - methods := methods reject: [ :method | method isAbstract or: [ (method hasPragmaNamed: #ignoreForCoverage) ] ] . - - testClasses := aDTpluginConfiguration packagesSelected flatCollect: [ - :p | p classes ] -] - -{ #category : 'accessing' } -DTTestCoveragePlugin >> firstListLabel [ - ^ 'Test Packages' -] - -{ #category : 'api' } -DTTestCoveragePlugin >> itemsToBeAnalysedFor: packagesSelected [ - - ^ self packageOrganizer packages select: [ :p | p definedClasses anySatisfy: [ :c | c isTestCase not ] ] -] - -{ #category : 'ui' } -DTTestCoveragePlugin >> pluginPresenterClass [ - - ^ DTCoveragePluginPresenter -] - -{ #category : 'accessing' } -DTTestCoveragePlugin >> pragmaForResultTrees [ - ^ #'dtTestCoverageResultTreeNamed:order:' -] - -{ #category : 'api' } -DTTestCoveragePlugin >> resultButtonHelp [ - ^ 'Browse the method selected in the results list.' translated -] - -{ #category : 'api' } -DTTestCoveragePlugin >> runForConfiguration: aDTpluginConfiguration [ - - | suite collector coverage notExecuted result | - result := self pluginResultClass new. - self defineData: aDTpluginConfiguration. - suite := self suiteFor: testClasses. - collector := DTCoverageCollector new. - collector methods: methods. - coverage := collector runOn: [ self runTestSuites: { suite } ]. - notExecuted := coverage uncoveredMethods. - - methods ifNotEmpty: [ - result - percent: 1s2 - (notExecuted size / methods size asScaledDecimal: 2); - methodList: notExecuted; - partiallyCoveredMethods: coverage partiallyCoveredMethods ]. - ^ result -] - -{ #category : 'api' } -DTTestCoveragePlugin >> runSuite: aTestSuite withResult: aResult [ - - aTestSuite when: TestAnnouncement do: [ :testAnnouncement | - self announceStatusChanged: ('Running test {1}.' format: { testAnnouncement test asString }) ] - for: self. - [ aTestSuite run: aResult ] ensure: [ - aTestSuite unsubscribe: TestAnnouncement ] -] - -{ #category : 'api' } -DTTestCoveragePlugin >> runTestSuites: testSuites [ - | result | - result := TestAsserter classForTestResult new. - CurrentExecutionEnvironment - runTestsBy: [ testSuites - do: [ :testSuite | self runSuite: testSuite withResult: result ] - displayingProgress: 'Running Tests' ] -] - -{ #category : 'accessing' } -DTTestCoveragePlugin >> secondListLabel [ - ^ 'Package under coverage' -] - -{ #category : 'api' } -DTTestCoveragePlugin >> setSelectionModeOfItemsList: aListPresenter [ - aListPresenter - beMultipleSelection; - unselectAll -] - -{ #category : 'api' } -DTTestCoveragePlugin >> startButtonHelp [ - ^ 'Run test coverage in selected packages' translated -] - -{ #category : 'api' } -DTTestCoveragePlugin >> startButtonLabel [ - ^ 'Run Coverage' translated -] - -{ #category : 'api' } -DTTestCoveragePlugin >> suiteFor: classesSelected [ - "Return the suite for all the selected test case classes" - - | suite | - suite := TestSuite new. - classesSelected do: [ :each | - each isAbstract ifFalse: [ - each isTestCase ifTrue: [ each addToSuiteFromSelectors: suite ] ] ]. - ^ suite name: 'Test' -] diff --git a/src/DrTests-TestCoverage/DTTestCoverageResult.class.st b/src/DrTests-TestCoverage/DTTestCoverageResult.class.st deleted file mode 100644 index 31e69ccad09..00000000000 --- a/src/DrTests-TestCoverage/DTTestCoverageResult.class.st +++ /dev/null @@ -1,90 +0,0 @@ -" -I build a tree with information: --percent of covered methods in the selected packages --List of the uncovered methods -I am used in DrTestsUI to show the results in a orderly manner. -" -Class { - #name : 'DTTestCoverageResult', - #superclass : 'DTPluginResult', - #instVars : [ - 'methodList', - 'percent', - 'partiallyCoveredMethods' - ], - #category : 'DrTests-TestCoverage', - #package : 'DrTests-TestCoverage' -} - -{ #category : 'accessing' } -DTTestCoverageResult >> buildTreeForUI [ - - ^ DTTreeNode new - subResults: (self methodList - ifNotNil: [ - {(DTTreeNode new - name: (percent * 100 printShowingDecimalPlaces: 2) , ' % Code Coverage'; - subResults: {}; - yourself). - (DTTreeNode new - name: 'Uncovered methods'; - subResults: (self methodList collect: [:each | each asResultForDrTest]); - yourself). - (DTTreeNode new - name: 'Partially covered methods'; - subResults: (self partiallyCoveredMethods collect: [:each | each asResultForDrTest]); - yourself)} - ]ifNil: [ - {(DTTreeNode new - name: 'no package has been selected'; - subResults: {}; - yourself)} - ]) -] - -{ #category : 'accessing' } -DTTestCoverageResult >> methodList [ - ^methodList -] - -{ #category : 'accessing' } -DTTestCoverageResult >> methodList: aCollectionOfMethods [ - methodList := aCollectionOfMethods -] - -{ #category : 'accessing' } -DTTestCoverageResult >> partiallyCoveredMethods [ - - ^ partiallyCoveredMethods -] - -{ #category : 'accessing' } -DTTestCoverageResult >> partiallyCoveredMethods: aCollectionOfMethods [ - - partiallyCoveredMethods := aCollectionOfMethods -] - -{ #category : 'accessing' } -DTTestCoverageResult >> percent [ - ^ percent -] - -{ #category : 'accessing' } -DTTestCoverageResult >> percent: anObject [ - percent := anObject -] - -{ #category : 'accessing' } -DTTestCoverageResult >> summarizeInfo [ - "Text showed in miniDrTests with info of the result " - - ^ String - streamContents: [ :s | - s - << (percent*100 printShowingDecimalPlaces: 2); - << ' % Code Coverage'; - << String cr; - << 'Uncovered methods:'; - << String cr; - << self methodList size asString ] -] diff --git a/src/DrTests-TestCoverage/package.st b/src/DrTests-TestCoverage/package.st deleted file mode 100644 index dda987b694e..00000000000 --- a/src/DrTests-TestCoverage/package.st +++ /dev/null @@ -1 +0,0 @@ -Package { #name : 'DrTests-TestCoverage' } diff --git a/src/DrTests-Tests/DTCoveragePluginPresenterTest.class.st b/src/DrTests-Tests/DTCoveragePluginPresenterTest.class.st deleted file mode 100644 index 76434a080c3..00000000000 --- a/src/DrTests-Tests/DTCoveragePluginPresenterTest.class.st +++ /dev/null @@ -1,39 +0,0 @@ -Class { - #name : 'DTCoveragePluginPresenterTest', - #superclass : 'TestCase', - #instVars : [ - 'presenter' - ], - #category : 'DrTests-Tests', - #package : 'DrTests-Tests' -} - -{ #category : 'running' } -DTCoveragePluginPresenterTest >> setUp [ - - super setUp. - presenter := MockDTCoveragePluginPresenter new -] - -{ #category : 'tests' } -DTCoveragePluginPresenterTest >> testEmptyInitializeOfAttributes [ - - | emptyPresenter | - emptyPresenter := MockDTCoveragePluginPresenter new . - self assert: emptyPresenter uncoveredNodes isNil. - self assert: emptyPresenter coveredNodes isNil. - self assert: emptyPresenter yellowNodes isNil. -] - -{ #category : 'tests' } -DTCoveragePluginPresenterTest >> testUpdateSourceCodePanelUncovered [ - - | oneMethod | - oneMethod := MockForCoverage >> #method2ForMock:. - presenter cleanAttributesForHighlighting . - presenter defineColorCoverage: oneMethod. - - self assert: presenter uncoveredNodes size equals: 1. - self assert: presenter coveredNodes size isZero . - self assert: presenter yellowNodes size isZero. -] diff --git a/src/DrTests-Tests/DTFilterableListPresenterTest.class.st b/src/DrTests-Tests/DTFilterableListPresenterTest.class.st deleted file mode 100644 index c1ebb95aa8a..00000000000 --- a/src/DrTests-Tests/DTFilterableListPresenterTest.class.st +++ /dev/null @@ -1,61 +0,0 @@ -" -A DTFilterableListPresenterTest is a test class for testing the behavior of DTFilterableListPresenter -" -Class { - #name : 'DTFilterableListPresenterTest', - #superclass : 'TestCase', - #instVars : [ - 'filterableList' - ], - #category : 'DrTests-Tests', - #package : 'DrTests-Tests' -} - -{ #category : 'running' } -DTFilterableListPresenterTest >> setUp [ - super setUp. - filterableList := DTFilterableListPresenter new - items: (1 to: 20); - displayBlock: #asString; - yourself -] - -{ #category : 'tests' } -DTFilterableListPresenterTest >> testFilterStrings [ - - filterableList filterTextInput text: 'foo|bar'. - - self assertCollection: filterableList filterStrings hasSameElements: #( '*foo*' '*bar*' ). - - filterableList filterTextInput text: '|bar'. - - self assertCollection: filterableList filterStrings hasSameElements: #( '*bar*' ). - - filterableList filterTextInput text: 'foo|'. - - self assertCollection: filterableList filterStrings hasSameElements: #( '*foo*' ) -] - -{ #category : 'tests' } -DTFilterableListPresenterTest >> testFilterWorks [ - self assertCollection: filterableList allItems equals: (1 to: 20). - self assertCollection: filterableList visibleItems equals: (1 to: 20). - - filterableList filterTextInput text: '2'. - - self assertCollection: filterableList allItems equals: (1 to: 20). - self assertCollection: filterableList visibleItems equals: #(2 12 20). - - filterableList filterTextInput text: ''. - - self assertCollection: filterableList allItems equals: filterableList visibleItems. "We want to show everything if no filter is written." -] - -{ #category : 'running' } -DTFilterableListPresenterTest >> testLabel [ - self assert: filterableList label equals: ''. - - filterableList label: 'title'. - - self assert: filterableList label equals: 'title' -] diff --git a/src/DrTests-Tests/DTMockPlugin.class.st b/src/DrTests-Tests/DTMockPlugin.class.st deleted file mode 100644 index f90aa52c229..00000000000 --- a/src/DrTests-Tests/DTMockPlugin.class.st +++ /dev/null @@ -1,81 +0,0 @@ -" -A Mock object used in test -" -Class { - #name : 'DTMockPlugin', - #superclass : 'DrTestsPlugin', - #instVars : [ - 'hasBeenRun' - ], - #category : 'DrTests-Tests', - #package : 'DrTests-Tests' -} - -{ #category : 'testing' } -DTMockPlugin class >> isAbstract [ - ^ self = DTMockPlugin -] - -{ #category : 'api - accessing' } -DTMockPlugin class >> pluginName [ - - ^ 'Mock plugin for test' -] - -{ #category : 'api - accessing' } -DTMockPlugin class >> pluginResultClass [ - ^ DTMockPluginResult -] - -{ #category : 'api - accessing' } -DTMockPlugin class >> weight [ - ^ 40 -] - -{ #category : 'accessing' } -DTMockPlugin >> hasBeenRun [ - ^ hasBeenRun -] - -{ #category : 'initialization' } -DTMockPlugin >> initialize [ - - super initialize. - hasBeenRun := false -] - -{ #category : 'api' } -DTMockPlugin >> packagesAvailableForAnalysis [ - "This is a seleciton only for tests" - - ^ {self class package} -] - -{ #category : 'accessing' } -DTMockPlugin >> pragmaForResultTrees [ - ^ #'pragmaForTest:order:' -] - -{ #category : 'api' } -DTMockPlugin >> resultButtonHelp [ - - ^ 'Result help?' -] - -{ #category : 'api' } -DTMockPlugin >> runForConfiguration: aDTpluginConfiguration [ - hasBeenRun := true. - ^ DTMockPluginResult new -] - -{ #category : 'api' } -DTMockPlugin >> startButtonHelp [ - - ^ 'Help me!' -] - -{ #category : 'api' } -DTMockPlugin >> startButtonLabel [ - - ^ 'Mock start' -] diff --git a/src/DrTests-Tests/DTMockPluginResult.class.st b/src/DrTests-Tests/DTMockPluginResult.class.st deleted file mode 100644 index 7277266050c..00000000000 --- a/src/DrTests-Tests/DTMockPluginResult.class.st +++ /dev/null @@ -1,32 +0,0 @@ -" -A Mock object used in test -" -Class { - #name : 'DTMockPluginResult', - #superclass : 'DTPluginResult', - #category : 'DrTests-Tests', - #package : 'DrTests-Tests' -} - -{ #category : 'accessing' } -DTMockPluginResult >> backgroundColor [ - " Backgournd color, although untested is used by updateResultLabel, which is called after a test suite is runned " - " It is untested, so we return a random color" - ^ Color black -] - -{ #category : 'accessing' } -DTMockPluginResult >> buildAnotherTreeForUI [ - - ^ DTTreeNode new - subResults: {}; - yourself -] - -{ #category : 'accessing' } -DTMockPluginResult >> buildTreeForUI [ - - ^ DTTreeNode new - subResults: {}; - yourself -] diff --git a/src/DrTests-Tests/DTMockPluginTest.class.st b/src/DrTests-Tests/DTMockPluginTest.class.st deleted file mode 100644 index a3c8c5c1cc7..00000000000 --- a/src/DrTests-Tests/DTMockPluginTest.class.st +++ /dev/null @@ -1,22 +0,0 @@ -" -A DTMockPluginTest is a test class for testing the behavior of DTMockPlugin -" -Class { - #name : 'DTMockPluginTest', - #superclass : 'TestCase', - #category : 'DrTests-Tests', - #package : 'DrTests-Tests' -} - -{ #category : 'tests' } -DTMockPluginTest >> testResultTreeViews [ - | plugin treeViews | - plugin := DTMockPlugin new. - - treeViews := plugin resultTreeViews. - - self assert: treeViews size equals: 2. - - self assert: treeViews first name equals: 'for tests'. - self assert: treeViews second name equals: 'for other tests' -] diff --git a/src/DrTests-Tests/DrTestsTestRunnerTest.class.st b/src/DrTests-Tests/DrTestsTestRunnerTest.class.st deleted file mode 100644 index 11558bfcdd7..00000000000 --- a/src/DrTests-Tests/DrTestsTestRunnerTest.class.st +++ /dev/null @@ -1,80 +0,0 @@ -" -A DrTestsUITest is a test class for testing the behavior of DrTests-TestRunner -" -Class { - #name : 'DrTestsTestRunnerTest', - #superclass : 'TestCase', - #instVars : [ - 'plugin', - 'package', - 'testToReRun', - 'conf', - 'reRunconf', - 'testCase' - ], - #category : 'DrTests-Tests', - #package : 'DrTests-Tests' -} - -{ #category : 'running' } -DrTestsTestRunnerTest >> setUp [ - - super setUp. - package := self packageOrganizer packageNamed: 'DrTests-TestCoverage-Tests-Mocks'. - testToReRun := DTCoverageMockTest selector: #testMethod1forMock. - testCase := DTCoverageMockTest. - conf := DTPluginConfiguration - items: ({ package } flatCollect: [ :p | p definedClasses select: [ :c | c allSuperclasses includes: TestCase ] ]) - packages: { package }. - reRunconf := DTReRunConfiguration new. - plugin := DTTestsRunnerPlugin new -] - -{ #category : 'tests' } -DrTestsTestRunnerTest >> testAllSelectedClassesAreTestCases [ - - | thePackage | - thePackage := plugin packagesAvailableForAnalysis anyOne. - self assert: ((plugin itemsToBeAnalysedFor: {thePackage}) flattened allSatisfy: [ :each | each isTestCase ]) -] - -{ #category : 'tests' } -DrTestsTestRunnerTest >> testReRunResultIsDTTestRunnerResult [ - | pluginResult | - pluginResult := plugin runForConfiguration: conf. - reRunconf := DTReRunConfiguration new - previousResult: pluginResult; - configurationToRun: (DTTestsRunnerConfiguration items: { testToReRun }); - yourself. - self - assert: (plugin runForConfiguration: reRunconf) class - equals: DTTestsRunnerResult -] - -{ #category : 'tests' } -DrTestsTestRunnerTest >> testRunResultBuildTreeForUI [ - self - assert: (plugin runForConfiguration: conf) buildTreeForUI class - equals: DTTreeNode -] - -{ #category : 'tests' } -DrTestsTestRunnerTest >> testRunResultIsDTTestRunnerResult [ - self - assert: (plugin runForConfiguration: conf) class - equals: DTTestsRunnerResult -] - -{ #category : 'tests' } -DrTestsTestRunnerTest >> testSelectedPackagesContainTestCases [ - - self assert: (plugin packagesAvailableForAnalysis allSatisfy: [ :pkg | - pkg definedClasses anySatisfy: [ :class | - class isTestCase ] ]) -] - -{ #category : 'tests' } -DrTestsTestRunnerTest >> testTestResultIsNotEmpty [ - self - deny: (plugin runForConfiguration: conf) testResults passed isEmpty -] diff --git a/src/DrTests-Tests/DrTestsTestRunnerUITest.class.st b/src/DrTests-Tests/DrTestsTestRunnerUITest.class.st deleted file mode 100644 index f00f03257b5..00000000000 --- a/src/DrTests-Tests/DrTestsTestRunnerUITest.class.st +++ /dev/null @@ -1,26 +0,0 @@ -" -A DrTestsUITest is a test class for testing the behavior of DrTests-TestRunner UI -" -Class { - #name : 'DrTestsTestRunnerUITest', - #superclass : 'TestCase', - #instVars : [ - 'drTest' - ], - #category : 'DrTests-Tests', - #package : 'DrTests-Tests' -} - -{ #category : 'running' } -DrTestsTestRunnerUITest >> setUp [ - - super setUp. - drTest := DrTests on: { DTTestsRunnerPlugin } -] - -{ #category : 'tests' } -DrTestsTestRunnerUITest >> testRunTestsUpdatesUIWithResults [ - - drTest pluginPresenter startButton performAction. - self assert: drTest pluginPresenter resultsList roots notEmpty -] diff --git a/src/DrTests-Tests/DrTestsUITest.class.st b/src/DrTests-Tests/DrTestsUITest.class.st deleted file mode 100644 index 3695a66be92..00000000000 --- a/src/DrTests-Tests/DrTestsUITest.class.st +++ /dev/null @@ -1,163 +0,0 @@ -" -A DrTestsUITest is a test class for testing the behavior of DrTestsUI -" -Class { - #name : 'DrTestsUITest', - #superclass : 'TestCase', - #instVars : [ - 'drTestsUI', - 'plugins', - 'plugin1', - 'plugin2' - ], - #category : 'DrTests-Tests', - #package : 'DrTests-Tests' -} - -{ #category : 'running' } -DrTestsUITest >> setUp [ - "Hooks that subclasses may override to define the fixture of test." - - super setUp. - plugin1 := DTTestsRunnerPlugin. - plugin2 := DTMockPlugin. - plugins := {plugin1. plugin2}. - drTestsUI := DrTests on: plugins -] - -{ #category : 'tests' } -DrTestsUITest >> testClickButtonRunCallsPluginRun [ - drTestsUI pluginsDropList selectItem: DTMockPlugin. - drTestsUI pluginPresenter startButton performAction. - self assert: drTestsUI currentPlugin hasBeenRun -] - -{ #category : 'tests' } -DrTestsUITest >> testCurrentPluginIsSelectedInDropDown [ - | currentPluginSelected | - currentPluginSelected := drTestsUI pluginsDropList selectedItem. - self - assert: drTestsUI currentPlugin class - equals: currentPluginSelected -] - -{ #category : 'tests' } -DrTestsUITest >> testInitialPackagesAreInitialPluginPackages [ - self - assertCollection: drTestsUI pluginPresenter packagesList items - hasSameElements: drTestsUI currentPlugin packagesAvailableForAnalysis -] - -{ #category : 'tests' } -DrTestsUITest >> testInitialResultListIsEmpty [ - - self assert: drTestsUI pluginPresenter resultsList roots isEmpty -] - -{ #category : 'tests' } -DrTestsUITest >> testInitialSelectedPluginIsFirstPluginInList [ - - self assert: drTestsUI currentPlugin class equals: plugins first -] - -{ #category : 'tests' } -DrTestsUITest >> testInitialStatusIsInitialStatusPluginName [ - |status| - status:= (drTestsUI currentPlugin pluginName , ' plugin is ready to work!') translated. - - self - assert: drTestsUI statusLabel label - equals: ('{1}: {2}' format: { (drTestsUI dateAndTimeString ). status }) -] - -{ #category : 'tests' } -DrTestsUITest >> testInitialWindowTitleIsInitialPluginWindowTitle [ - - self - assert: drTestsUI title - equals: 'Dr Tests - ' , drTestsUI currentPlugin pluginName -] - -{ #category : 'tests' } -DrTestsUITest >> testMultipleSelectingPackagesWillUpdateTheClassesList [ - | currentPluginSelected randomPackage newPackagesSelected classesList packageSelected | - currentPluginSelected := drTestsUI pluginsDropList selectedItem. - newPackagesSelected := OrderedCollection new. - packageSelected := drTestsUI pluginPresenter packagesList items anyOne. - randomPackage := (drTestsUI pluginPresenter packagesList items - \ {packageSelected}) anyOne. - newPackagesSelected add: packageSelected. - newPackagesSelected add: randomPackage. - drTestsUI pluginPresenter whenPackagesSelectionChanged: newPackagesSelected. - classesList := currentPluginSelected new - itemsToBeAnalysedFor: newPackagesSelected. - self - assertCollection: drTestsUI pluginPresenter itemsList items - hasSameElements: classesList flattened -] - -{ #category : 'tests' } -DrTestsUITest >> testNoPackageSelected [ - self - assertCollection: drTestsUI pluginPresenter itemsList items - hasSameElements: #() -] - -{ #category : 'tests' } -DrTestsUITest >> testPluginsAreConfiguredPluginsOnly [ - self - assert: drTestsUI pluginsDropList listItems asArray - equals: plugins -] - -{ #category : 'tests' } -DrTestsUITest >> testSelectingPackageWillUpdateTheClassesList [ - | newPackagesSelected | - newPackagesSelected := {drTestsUI pluginPresenter packagesList items - anyOne}. - drTestsUI pluginPresenter whenPackagesSelectionChanged: newPackagesSelected. - self - assertCollection: drTestsUI pluginPresenter itemsList items - hasSameElements: (drTestsUI currentPlugin itemsToBeAnalysedFor: newPackagesSelected) -] - -{ #category : 'tests' } -DrTestsUITest >> testSelectingPluginWillUpdateCurrentPluginInstanceVariable [ - drTestsUI pluginsDropList selectItem: plugin2. - self assert: drTestsUI currentPlugin class equals: plugin2 -] - -{ #category : 'tests' } -DrTestsUITest >> testSelectingPluginWillUpdatePackagesList [ - - drTestsUI pluginsDropList selectItem: plugin2. - self - assertCollection: drTestsUI pluginPresenter packagesList items - hasSameElements: - drTestsUI currentPlugin packagesAvailableForAnalysis -] - -{ #category : 'tests' } -DrTestsUITest >> testSelectingPluginWillUpdateWindowTitle [ - - drTestsUI pluginsDropList selectItem: plugin2. - self - assert: drTestsUI title - equals: 'Dr Tests - ' , drTestsUI currentPlugin pluginName -] - -{ #category : 'tests' } -DrTestsUITest >> testStartButtonHelpIsCurrentPluginStartButtonHelp [ - - self - assert: drTestsUI pluginPresenter startButton help - equals: drTestsUI currentPlugin startButtonHelp -] - -{ #category : 'tests' } -DrTestsUITest >> testStartButtonLabelIsCurrentPluginStartButtonLabel [ - - self - assert: drTestsUI pluginPresenter startButton label - equals: drTestsUI currentPlugin startButtonLabel -] diff --git a/src/DrTests-Tests/MockDTCoveragePluginPresenter.class.st b/src/DrTests-Tests/MockDTCoveragePluginPresenter.class.st deleted file mode 100644 index 1b07855540c..00000000000 --- a/src/DrTests-Tests/MockDTCoveragePluginPresenter.class.st +++ /dev/null @@ -1,32 +0,0 @@ -Class { - #name : 'MockDTCoveragePluginPresenter', - #superclass : 'DTCoveragePluginPresenter', - #category : 'DrTests-Tests', - #package : 'DrTests-Tests' -} - -{ #category : 'accessing - attributes' } -MockDTCoveragePluginPresenter >> coveredNodes [ - ^ coveredNodes -] - -{ #category : 'accessing - attributes' } -MockDTCoveragePluginPresenter >> uncoveredNodes [ - ^ uncoveredNodes -] - -{ #category : 'initialization' } -MockDTCoveragePluginPresenter >> updatePresenter [ - "I rewrite this method by commenting, so this class cannot be initialized and run other methods that are unnecessary to perform the tests." - - "super updatePresenter. - self updatePackagesList. - self updateResultViewsDropList." - - -] - -{ #category : 'accessing - attributes' } -MockDTCoveragePluginPresenter >> yellowNodes [ - ^ yellowNodes -] diff --git a/src/DrTests-Tests/package.st b/src/DrTests-Tests/package.st deleted file mode 100644 index c8aa68db9d0..00000000000 --- a/src/DrTests-Tests/package.st +++ /dev/null @@ -1 +0,0 @@ -Package { #name : 'DrTests-Tests' } diff --git a/src/DrTests-TestsProfiling-Tests/DTTestProfilingTest.class.st b/src/DrTests-TestsProfiling-Tests/DTTestProfilingTest.class.st deleted file mode 100644 index 521bd8b1458..00000000000 --- a/src/DrTests-TestsProfiling-Tests/DTTestProfilingTest.class.st +++ /dev/null @@ -1,101 +0,0 @@ -Class { - #name : 'DTTestProfilingTest', - #superclass : 'TestCase', - #instVars : [ - 'package', - 'classes', - 'dTconf', - 'plugin' - ], - #category : 'DrTests-TestsProfiling-Tests', - #package : 'DrTests-TestsProfiling-Tests' -} - -{ #category : 'running' } -DTTestProfilingTest >> setUp [ - - super setUp. - plugin := DTTestsProfilingPlugin new. - package := self packageOrganizer packageNamed: 'DrTests-TestCoverage-Tests-Mocks'. - classes := plugin itemsToBeAnalysedFor: { package }. - dTconf := DTPluginConfiguration items: classes packages: { package } -] - -{ #category : 'running' } -DTTestProfilingTest >> testCoverageResultIsAnInstanceOfDTTestProfilingResult [ - | result | - result := plugin runForConfiguration: dTconf. - self assert: result class equals: DTTestsProfilingResult -] - -{ #category : 'running' } -DTTestProfilingTest >> testDTTestCoverageResulLeafsContentHaveATestCase [ - | resultTree leafs | - resultTree := (plugin runForConfiguration: dTconf) buildTreeForUI. - leafs := resultTree subResults at: 4. - self - assert: - (leafs subResults - allSatisfy: [ :subResult | subResult content testCase isKindOf: TestCase]) -] - -{ #category : 'running' } -DTTestProfilingTest >> testDTTestCoverageResulLeafsContentHaveATestResult [ - | resultTree leafs | - resultTree := (plugin runForConfiguration: dTconf) buildTreeForUI. - leafs := resultTree subResults at: 4. - self - assert: - (leafs subResults - allSatisfy: [ :subResult | subResult content testResult isKindOf: TestResult ]) -] - -{ #category : 'running' } -DTTestProfilingTest >> testDTTestCoverageResulLeafsContentHaveDuration [ - | resultTree leafs | - resultTree := (plugin runForConfiguration: dTconf) buildTreeForUI. - leafs := resultTree subResults at: 4. - self - assert: - (leafs subResults - allSatisfy: [ :subResult | subResult content duration class = Duration ]) -] - -{ #category : 'running' } -DTTestProfilingTest >> testDTTestCoverageResultHas4Nodes [ - | resultTree | - resultTree := (plugin runForConfiguration: dTconf) buildTreeForUI. - self assert: resultTree subResults size equals: 4 -] - -{ #category : 'running' } -DTTestProfilingTest >> testDTTestCoverageResultTheSecondNodeSubResultsAreLeafs [ - | resultTree leafs | - resultTree := (plugin runForConfiguration: dTconf) buildTreeForUI. - leafs := resultTree subResults at: 3. - self - assert: - (leafs subResults - allSatisfy: [ :subResult | subResult class = DTTreeLeafNode ]) -] - -{ #category : 'running' } -DTTestProfilingTest >> testDTTestCoverageResultTheThirdNodeSubResultsLeafsContentsAreDTTestCaseProfilingData [ - | resultTree leafs | - resultTree := (plugin runForConfiguration: dTconf) buildTreeForUI. - leafs := resultTree subResults at: 3. - self - assert: - (leafs subResults - allSatisfy: [ :subResult | subResult content class = DTTestCaseProfilingData ]) -] - -{ #category : 'running' } -DTTestProfilingTest >> testItemsAvailableInTestProfilerPlugin [ - | items | - items := plugin itemsToBeAnalysedFor: {package}. - self - assert: - (items - allSatisfy: [ :p | p methods anySatisfy: [ :m | m isTestMethod ] ]) -] diff --git a/src/DrTests-TestsProfiling-Tests/package.st b/src/DrTests-TestsProfiling-Tests/package.st deleted file mode 100644 index 386e93de0cc..00000000000 --- a/src/DrTests-TestsProfiling-Tests/package.st +++ /dev/null @@ -1 +0,0 @@ -Package { #name : 'DrTests-TestsProfiling-Tests' } diff --git a/src/DrTests-TestsProfiling/DTTestCaseProfilingData.class.st b/src/DrTests-TestsProfiling/DTTestCaseProfilingData.class.st deleted file mode 100644 index c115882534f..00000000000 --- a/src/DrTests-TestsProfiling/DTTestCaseProfilingData.class.st +++ /dev/null @@ -1,76 +0,0 @@ -" -I stores the information for every test. -I have the duration that is the times it takes when a test is executed. -I also have the testCase ande the testResult. -" -Class { - #name : 'DTTestCaseProfilingData', - #superclass : 'Object', - #instVars : [ - 'testCase', - 'duration', - 'testResult' - ], - #category : 'DrTests-TestsProfiling', - #package : 'DrTests-TestsProfiling' -} - -{ #category : 'instance creation' } -DTTestCaseProfilingData class >> testCase: testCase duration: aDuration [ - ^ self new - testCase: testCase; - duration: aDuration; - yourself -] - -{ #category : 'instance creation' } -DTTestCaseProfilingData class >> testCase: testCase duration: aDuration testResult: aTestResult [ - ^ self new - testCase: testCase; - duration: aDuration; - testResult: aTestResult; - yourself -] - -{ #category : 'actions' } -DTTestCaseProfilingData >> drTestsBrowse [ - - self browser - openOnClass: testCase class - selector: testCase selector -] - -{ #category : 'accessing' } -DTTestCaseProfilingData >> drTestsName [ - ^ self testCase asString , ' : ', self duration asString -] - -{ #category : 'accessing' } -DTTestCaseProfilingData >> duration [ - ^ duration -] - -{ #category : 'accessing' } -DTTestCaseProfilingData >> duration: anObject [ - duration := anObject -] - -{ #category : 'accessing' } -DTTestCaseProfilingData >> testCase [ - ^ testCase -] - -{ #category : 'accessing' } -DTTestCaseProfilingData >> testCase: anObject [ - testCase := anObject -] - -{ #category : 'accessing' } -DTTestCaseProfilingData >> testResult [ - ^ testResult -] - -{ #category : 'accessing' } -DTTestCaseProfilingData >> testResult: anObject [ - testResult := anObject -] diff --git a/src/DrTests-TestsProfiling/DTTestsProfilerVisitor.class.st b/src/DrTests-TestsProfiling/DTTestsProfilerVisitor.class.st deleted file mode 100644 index 6e1f9e181be..00000000000 --- a/src/DrTests-TestsProfiling/DTTestsProfilerVisitor.class.st +++ /dev/null @@ -1,45 +0,0 @@ -" -I collect the time for every executed test. -I create a DTTestCaseProfilingData for each test and store all of them in a collection. -" -Class { - #name : 'DTTestsProfilerVisitor', - #superclass : 'SUnitVisitor', - #instVars : [ - 'profilingData' - ], - #category : 'DrTests-TestsProfiling', - #package : 'DrTests-TestsProfiling' -} - -{ #category : 'initialization' } -DTTestsProfilerVisitor >> initialize [ - super initialize. - self profilingData: OrderedCollection new -] - -{ #category : 'accessing' } -DTTestsProfilerVisitor >> profilingData [ - ^ profilingData -] - -{ #category : 'accessing' } -DTTestsProfilerVisitor >> profilingData: anObject [ - profilingData := anObject -] - -{ #category : 'visiting' } -DTTestsProfilerVisitor >> visitTestCase: aTestCase [ - "Defines the behaviour while visiting a TestCase. - This method must be overriden by concrete subclasses. - " - "We make explicit the dependency to duration" - - | aTestresult | - self profilingData - add: - (DTTestCaseProfilingData - testCase: aTestCase - duration: (Duration milliSeconds: ([ aTestresult := aTestCase run ] millisecondsToRun)) - testResult: aTestresult) -] diff --git a/src/DrTests-TestsProfiling/DTTestsProfilingPlugin.class.st b/src/DrTests-TestsProfiling/DTTestsProfilingPlugin.class.st deleted file mode 100644 index 0888c341aad..00000000000 --- a/src/DrTests-TestsProfiling/DTTestsProfilingPlugin.class.st +++ /dev/null @@ -1,67 +0,0 @@ -" -I am a DrTestPlugin. -I show the time that takes execute the test and the result of the tests. -" -Class { - #name : 'DTTestsProfilingPlugin', - #superclass : 'DrTestsPlugin', - #category : 'DrTests-TestsProfiling', - #package : 'DrTests-TestsProfiling' -} - -{ #category : 'api - accessing' } -DTTestsProfilingPlugin class >> pluginName [ - ^ 'Tests Profiler' -] - -{ #category : 'api - accessing' } -DTTestsProfilingPlugin class >> pluginResultClass [ - ^ DTTestsProfilingResult -] - -{ #category : 'api - accessing' } -DTTestsProfilingPlugin class >> weight [ - ^ 5 -] - -{ #category : 'api' } -DTTestsProfilingPlugin >> firstListLabel [ - ^ 'Packages' -] - -{ #category : 'accessing' } -DTTestsProfilingPlugin >> pragmaForResultTrees [ - ^ #'drTestsProfilingResultTreeNamed:order:' -] - -{ #category : 'api' } -DTTestsProfilingPlugin >> resultButtonHelp [ - ^ 'Browse the test selected in the results list.' translated -] - -{ #category : 'api' } -DTTestsProfilingPlugin >> runForConfiguration: aDTpluginConfiguration [ - | results profilerVisitor | - profilerVisitor := DTTestsProfilerVisitor new. - aDTpluginConfiguration asTestSuite - acceptSUnitVisitor: profilerVisitor. - results := self pluginResultClass new - testResults: profilerVisitor profilingData; - yourself. - ^ results -] - -{ #category : 'api' } -DTTestsProfilingPlugin >> secondListLabel [ - ^ 'Tests Cases' -] - -{ #category : 'api' } -DTTestsProfilingPlugin >> startButtonHelp [ - ^ 'Run tests selected.' translated -] - -{ #category : 'api' } -DTTestsProfilingPlugin >> startButtonLabel [ - ^ 'Profile Tests' translated -] diff --git a/src/DrTests-TestsProfiling/DTTestsProfilingResult.class.st b/src/DrTests-TestsProfiling/DTTestsProfilingResult.class.st deleted file mode 100644 index 2c1645c32b3..00000000000 --- a/src/DrTests-TestsProfiling/DTTestsProfilingResult.class.st +++ /dev/null @@ -1,104 +0,0 @@ -" -I build a tree with DTTestCaseProfilingData objects listed in groups: --Errors --Failures --Skipped tests --Passed test -Each group has in adition the total execution time for each test. -I am used in DrTestsUI to show the results in a orderly manner. -" -Class { - #name : 'DTTestsProfilingResult', - #superclass : 'DTPluginResult', - #instVars : [ - 'testsResult' - ], - #category : 'DrTests-TestsProfiling', - #package : 'DrTests-TestsProfiling' -} - -{ #category : 'accessing' } -DTTestsProfilingResult >> buildTreeForUI [ - - ^ DTTreeNode new - subResults: - {(self buildTreeNode - name: 'Errors'; - subResults: - ((self testResults - select: - [ :testCaseToTimeTaken | testCaseToTimeTaken testResult errors isNotEmpty ]) - collect: [ :testCaseToTimeTaken | - DTTreeLeafNode new - content: testCaseToTimeTaken; - yourself ]); - yourself). - (self buildTreeNode - name: 'Failures'; - subResults: - ((self testResults - select: - [ :testCaseToTimeTaken | testCaseToTimeTaken testResult failures isNotEmpty ]) - collect: [ :testCaseToTimeTaken | - DTTreeLeafNode new - content: testCaseToTimeTaken; - yourself ]); - yourself). - (self buildTreeNode - name: 'Skipped tests'; - subResults: - ((self testResults - select: - [ :testCaseToTimeTaken | testCaseToTimeTaken testResult skipped isNotEmpty ]) - collect: [ :testCaseToTimeTaken | - DTTreeLeafNode new - content: testCaseToTimeTaken; - yourself ]); - yourself). - (self buildTreeNode - name: 'Passed tests'; - subResults: - ((self testResults - select: - [ :testProfilerResult | testProfilerResult testResult passed isNotEmpty ]) - collect: [ :testCaseToTimeTaken | - DTTreeLeafNode new - content: testCaseToTimeTaken; - yourself ]); - yourself)}; - yourself -] - -{ #category : 'accessing' } -DTTestsProfilingResult >> buildTreeGroupedByClass [ - - ^ self buildTreeNode - subResults: ((self testResults groupedBy: [ :d | d testCase class ]) associations collect: [ :assoc | - self buildTreeNode - name: assoc key name; - subResults: (assoc value collect: [ :t | DTTreeLeafNode content: t ]); - yourself ]); - yourself -] - -{ #category : 'private' } -DTTestsProfilingResult >> buildTreeNode [ - "Returns a node with the sub-results aggregator initialized in a way that it sum the durations of sub results." - - ^ DTTreeNode new - subResultsAggregator: [ :subResults | - subResults - inject: 0 milliSecond - into: [ :totalDuration :dtTreeLeaf | totalDuration + dtTreeLeaf content duration ] ]; - yourself -] - -{ #category : 'accessing' } -DTTestsProfilingResult >> testResults [ - ^ testsResult -] - -{ #category : 'accessing' } -DTTestsProfilingResult >> testResults: anObject [ - testsResult := anObject -] diff --git a/src/DrTests-TestsProfiling/package.st b/src/DrTests-TestsProfiling/package.st deleted file mode 100644 index c843a6b963d..00000000000 --- a/src/DrTests-TestsProfiling/package.st +++ /dev/null @@ -1 +0,0 @@ -Package { #name : 'DrTests-TestsProfiling' } diff --git a/src/DrTests-TestsRunner/DTDebugTestCommand.class.st b/src/DrTests-TestsRunner/DTDebugTestCommand.class.st deleted file mode 100644 index bb6eca2693c..00000000000 --- a/src/DrTests-TestsRunner/DTDebugTestCommand.class.st +++ /dev/null @@ -1,29 +0,0 @@ -" -I am the command allowing one to debug a failing test. -" -Class { - #name : 'DTDebugTestCommand', - #superclass : 'DTLeafResultCommand', - #category : 'DrTests-TestsRunner-Commands', - #package : 'DrTests-TestsRunner', - #tag : 'Commands' -} - -{ #category : 'hooks' } -DTDebugTestCommand >> canBeRun [ - ^ super canBeRun and: [ self resultSelected type isPass not ] -] - -{ #category : 'hooks' } -DTDebugTestCommand >> execute [ - self resultSelected content debug -] - -{ #category : 'initialization' } -DTDebugTestCommand >> initialize [ - - super initialize. - self - name: 'Debug test'; - description: 'Re-run the test selected and opens a debugger when an assertion fails.' -] diff --git a/src/DrTests-TestsRunner/DTErrorResultType.class.st b/src/DrTests-TestsRunner/DTErrorResultType.class.st deleted file mode 100644 index 1afe9ccbfcd..00000000000 --- a/src/DrTests-TestsRunner/DTErrorResultType.class.st +++ /dev/null @@ -1,26 +0,0 @@ -" -I model the fact that a test generated an error. -" -Class { - #name : 'DTErrorResultType', - #superclass : 'DTTestResultType', - #category : 'DrTests-TestsRunner-Results', - #package : 'DrTests-TestsRunner', - #tag : 'Results' -} - -{ #category : 'factory' } -DTErrorResultType class >> backgroundColorStyle [ - - ^ 'testError' -] - -{ #category : 'testing' } -DTErrorResultType >> isError [ - ^ true -] - -{ #category : 'accessing' } -DTErrorResultType >> name [ - ^ 'Error' -] diff --git a/src/DrTests-TestsRunner/DTExpectedFailureResultType.class.st b/src/DrTests-TestsRunner/DTExpectedFailureResultType.class.st deleted file mode 100644 index 23d4033b668..00000000000 --- a/src/DrTests-TestsRunner/DTExpectedFailureResultType.class.st +++ /dev/null @@ -1,26 +0,0 @@ -" -I model the fact that a tests expected to fail failed -" -Class { - #name : 'DTExpectedFailureResultType', - #superclass : 'DTTestResultType', - #category : 'DrTests-TestsRunner-Results', - #package : 'DrTests-TestsRunner', - #tag : 'Results' -} - -{ #category : 'factory' } -DTExpectedFailureResultType class >> backgroundColorStyle [ - - ^ 'testExpectedFailure' -] - -{ #category : 'accessing' } -DTExpectedFailureResultType >> isExpectedFailure [ - ^ true -] - -{ #category : 'accessing' } -DTExpectedFailureResultType >> name [ - ^ 'ExpectedFailure' -] diff --git a/src/DrTests-TestsRunner/DTFailResultType.class.st b/src/DrTests-TestsRunner/DTFailResultType.class.st deleted file mode 100644 index f3935a4d184..00000000000 --- a/src/DrTests-TestsRunner/DTFailResultType.class.st +++ /dev/null @@ -1,26 +0,0 @@ -" -I model the fact that a test failed. -" -Class { - #name : 'DTFailResultType', - #superclass : 'DTTestResultType', - #category : 'DrTests-TestsRunner-Results', - #package : 'DrTests-TestsRunner', - #tag : 'Results' -} - -{ #category : 'factory' } -DTFailResultType class >> backgroundColorStyle [ - - ^ 'testFail' -] - -{ #category : 'testing' } -DTFailResultType >> isFail [ - ^ true -] - -{ #category : 'accessing' } -DTFailResultType >> name [ - ^ 'Failure' -] diff --git a/src/DrTests-TestsRunner/DTPassResultType.class.st b/src/DrTests-TestsRunner/DTPassResultType.class.st deleted file mode 100644 index 915f026ae21..00000000000 --- a/src/DrTests-TestsRunner/DTPassResultType.class.st +++ /dev/null @@ -1,26 +0,0 @@ -" -I model the fact that a test passed. -" -Class { - #name : 'DTPassResultType', - #superclass : 'DTTestResultType', - #category : 'DrTests-TestsRunner-Results', - #package : 'DrTests-TestsRunner', - #tag : 'Results' -} - -{ #category : 'factory' } -DTPassResultType class >> backgroundColorStyle [ - - ^ 'testPass' -] - -{ #category : 'testing' } -DTPassResultType >> isPass [ - ^ true -] - -{ #category : 'accessing' } -DTPassResultType >> name [ - ^ 'Passing test' -] diff --git a/src/DrTests-TestsRunner/DTReRunConfiguration.extension.st b/src/DrTests-TestsRunner/DTReRunConfiguration.extension.st deleted file mode 100644 index 0577d966875..00000000000 --- a/src/DrTests-TestsRunner/DTReRunConfiguration.extension.st +++ /dev/null @@ -1,6 +0,0 @@ -Extension { #name : 'DTReRunConfiguration' } - -{ #category : '*DrTests-TestsRunner' } -DTReRunConfiguration >> handleResults: aPluginResult for: aPlugin [ - ^ aPlugin handleReRunResult: aPluginResult forConfiguration: self -] diff --git a/src/DrTests-TestsRunner/DTRerunCommand.class.st b/src/DrTests-TestsRunner/DTRerunCommand.class.st deleted file mode 100644 index 37321e574b5..00000000000 --- a/src/DrTests-TestsRunner/DTRerunCommand.class.st +++ /dev/null @@ -1,22 +0,0 @@ -" -I am the command allowing one to rerun a subparts of the results of a test-run. -" -Class { - #name : 'DTRerunCommand', - #superclass : 'DTResultCommand', - #category : 'DrTests-TestsRunner-Commands', - #package : 'DrTests-TestsRunner', - #tag : 'Commands' -} - -{ #category : 'executing' } -DTRerunCommand >> execute [ - self context drTests runPluginFor: (self plugin buildReRunConfigurationFrom: self context drTests) -] - -{ #category : 'initialization' } -DTRerunCommand >> initialize [ - - super initialize. - self name: 'Re-run all tests' -] diff --git a/src/DrTests-TestsRunner/DTSkippedResultType.class.st b/src/DrTests-TestsRunner/DTSkippedResultType.class.st deleted file mode 100644 index 42b0909cb45..00000000000 --- a/src/DrTests-TestsRunner/DTSkippedResultType.class.st +++ /dev/null @@ -1,26 +0,0 @@ -" -I model the fact that a test was skipped. -" -Class { - #name : 'DTSkippedResultType', - #superclass : 'DTTestResultType', - #category : 'DrTests-TestsRunner-Results', - #package : 'DrTests-TestsRunner', - #tag : 'Results' -} - -{ #category : 'factory' } -DTSkippedResultType class >> backgroundColorStyle [ - - ^ 'testSkipped' -] - -{ #category : 'testing' } -DTSkippedResultType >> isSkipped [ - ^ true -] - -{ #category : 'accessing' } -DTSkippedResultType >> name [ - ^ 'Skipped test' -] diff --git a/src/DrTests-TestsRunner/DTTestLeafNode.class.st b/src/DrTests-TestsRunner/DTTestLeafNode.class.st deleted file mode 100644 index 08a04122fda..00000000000 --- a/src/DrTests-TestsRunner/DTTestLeafNode.class.st +++ /dev/null @@ -1,32 +0,0 @@ -" -I am a leaf of the results tree for the test-runner plugin. - -Additionally to my superclass, I store the type of the result. -" -Class { - #name : 'DTTestLeafNode', - #superclass : 'DTTreeLeafNode', - #instVars : [ - 'type' - ], - #category : 'DrTests-TestsRunner-Base', - #package : 'DrTests-TestsRunner', - #tag : 'Base' -} - -{ #category : 'instance creation' } -DTTestLeafNode class >> content: anObject type: aTestResultType [ - ^ (self content: anObject) - type: aTestResultType; - yourself -] - -{ #category : 'accessing' } -DTTestLeafNode >> type [ - ^ type -] - -{ #category : 'accessing' } -DTTestLeafNode >> type: anObject [ - type := anObject -] diff --git a/src/DrTests-TestsRunner/DTTestResultType.class.st b/src/DrTests-TestsRunner/DTTestResultType.class.st deleted file mode 100644 index a203bea6dd5..00000000000 --- a/src/DrTests-TestsRunner/DTTestResultType.class.st +++ /dev/null @@ -1,90 +0,0 @@ -" -I model an abstract type of result for the run of a test case. -" -Class { - #name : 'DTTestResultType', - #superclass : 'Object', - #category : 'DrTests-TestsRunner-Results', - #package : 'DrTests-TestsRunner', - #tag : 'Results' -} - -{ #category : 'factory' } -DTTestResultType class >> backgroundColorStyle [ - ^ self subclassResponsibility -] - -{ #category : 'factory' } -DTTestResultType class >> error [ - ^ DTErrorResultType new -] - -{ #category : 'factory' } -DTTestResultType class >> expectedFailure [ - ^ DTExpectedFailureResultType new -] - -{ #category : 'factory' } -DTTestResultType class >> fail [ - ^ DTFailResultType new -] - -{ #category : 'factory' } -DTTestResultType class >> pass [ - ^ DTPassResultType new -] - -{ #category : 'factory' } -DTTestResultType class >> skipped [ - ^ DTSkippedResultType new -] - -{ #category : 'factory' } -DTTestResultType class >> textColor [ - ^ TestResult defaultColorText -] - -{ #category : 'factory' } -DTTestResultType class >> unexpectedPass [ - ^ DTUnexpectedPassResultType new -] - -{ #category : 'testing' } -DTTestResultType >> isError [ - ^ false -] - -{ #category : 'accessing' } -DTTestResultType >> isExpectedFailure [ - ^ false -] - -{ #category : 'testing' } -DTTestResultType >> isFail [ - ^ false -] - -{ #category : 'testing' } -DTTestResultType >> isPass [ - ^ false -] - -{ #category : 'testing' } -DTTestResultType >> isSkipped [ - ^ false -] - -{ #category : 'accessing' } -DTTestResultType >> isUnexpectedPass [ - ^ false -] - -{ #category : 'accessing' } -DTTestResultType >> name [ - ^ self subclassResponsibility -] - -{ #category : 'accessing' } -DTTestResultType >> pluralName [ - ^ self name , 's' -] diff --git a/src/DrTests-TestsRunner/DTTestsRunnerConfiguration.class.st b/src/DrTests-TestsRunner/DTTestsRunnerConfiguration.class.st deleted file mode 100644 index 7c28a93ef1c..00000000000 --- a/src/DrTests-TestsRunner/DTTestsRunnerConfiguration.class.st +++ /dev/null @@ -1,22 +0,0 @@ -" -I am a configuration for the tests runner plugin. - -I can be converted as a test suite via #asTestSuite. -" -Class { - #name : 'DTTestsRunnerConfiguration', - #superclass : 'DTPluginConfiguration', - #category : 'DrTests-TestsRunner-Base', - #package : 'DrTests-TestsRunner', - #tag : 'Base' -} - -{ #category : 'converting' } -DTTestsRunnerConfiguration >> asTestSuite [ - |newTestSuite| - newTestSuite := TestSuite new. - self items - reject: #drTestsIsAbstract "This method allows to either test a test case instance or a test suite depending on kind of item." - thenDo: [ :item | newTestSuite addTest: item drTestsSuite "This method allows to either add a test case instance or a test suite depending on kind of item." ]. - ^ newTestSuite -] diff --git a/src/DrTests-TestsRunner/DTTestsRunnerPlugin.class.st b/src/DrTests-TestsRunner/DTTestsRunnerPlugin.class.st deleted file mode 100644 index 268934d6a66..00000000000 --- a/src/DrTests-TestsRunner/DTTestsRunnerPlugin.class.st +++ /dev/null @@ -1,177 +0,0 @@ -" -I am the plugin implementing test runner for DrTests. -" -Class { - #name : 'DTTestsRunnerPlugin', - #superclass : 'DrTestsPlugin', - #category : 'DrTests-TestsRunner-Base', - #package : 'DrTests-TestsRunner', - #tag : 'Base' -} - -{ #category : 'api - accessing' } -DTTestsRunnerPlugin class >> pluginName [ - ^ 'Tests Runner' -] - -{ #category : 'api - accessing' } -DTTestsRunnerPlugin class >> pluginResultClass [ - ^ DTTestsRunnerResult -] - -{ #category : 'api - accessing' } -DTTestsRunnerPlugin class >> weight [ - ^ 0 -] - -{ #category : 'api' } -DTTestsRunnerPlugin >> allowMiniDrTests [ - ^ true -] - -{ #category : 'configuration building' } -DTTestsRunnerPlugin >> buildConfigurationFrom: aDrTests [ - "Builds a configuration from the plugin by reading the information held by the UI (aDrTests)." - ^ DTTestsRunnerConfiguration - items: aDrTests selectedItems - packages: aDrTests packagesSelected -] - -{ #category : 'api' } -DTTestsRunnerPlugin >> buildContextualMenuGroupWith: presenterInstance [ - - ^ (CmCommandGroup named: 'TestRunnerResult context menu') asSpecGroup - description: 'Commands related to re-run a result.'; - register: (DTDebugTestCommand forSpecContext: presenterInstance) beHiddenWhenCantBeRun; - register: (DTRerunCommand forSpecContext: presenterInstance) beHiddenWhenCantBeRun; - beDisplayedAsGroup; - yourself -] - -{ #category : 'api' } -DTTestsRunnerPlugin >> firstListLabel [ - ^ 'Packages' -] - -{ #category : 'api' } -DTTestsRunnerPlugin >> handleReRunResult: rerunnedResult forConfiguration: aDTRerunConfiguration [ - | oldResult | - oldResult := self - removeTests: aDTRerunConfiguration configurationToRun items - from: aDTRerunConfiguration previousResult testResults. - ^ self pluginResultClass new - testResults: (self joinTestResult: oldResult with: rerunnedResult testResults); - yourself -] - -{ #category : 'private' } -DTTestsRunnerPlugin >> joinTestResult: aTestResult with: partialResult [ - | newResult | - newResult := aTestResult. - partialResult passed do: [ :each | newResult addPass: each ]. - partialResult errors do: [ :each | newResult addError: each ]. - partialResult failures do: [ :each | newResult addFailure: each ]. - partialResult skipped do: [ :each | newResult addSkip: each ]. - ^ newResult -] - -{ #category : 'tests' } -DTTestsRunnerPlugin >> label: aString forSuite: aTestSuite [ - ^ String streamContents: [ :stream | - stream nextPutAll: 'Running '; print: aTestSuite tests size; space; nextPutAll: aString. - aTestSuite tests size > 1 ifTrue: [ stream nextPut: $s ] ] -] - -{ #category : 'accessing' } -DTTestsRunnerPlugin >> pragmaForResultTrees [ - ^ #'dtTestRunnerResultTreeNamed:order:' -] - -{ #category : 'private' } -DTTestsRunnerPlugin >> removeTest: aTest from: aTestResult [ - aTestResult - passed: (aTestResult passed copyWithout: aTest). - aTestResult - failures: (aTestResult failures copyWithout: aTest). - aTestResult - errors: (aTestResult errors copyWithout: aTest). - ^ aTestResult -] - -{ #category : 'private' } -DTTestsRunnerPlugin >> removeTests: aCollectionOfTest from: aTestResult [ - aCollectionOfTest do: [ :test | - self removeTest: test from: aTestResult ]. - ^ aTestResult -] - -{ #category : 'api' } -DTTestsRunnerPlugin >> resultButtonHelp [ - ^ 'Browse the test selected in the results list.' translated -] - -{ #category : 'api' } -DTTestsRunnerPlugin >> runForConfiguration: aDTpluginConfiguration [ - | results | - results := self pluginResultClass new - testResults: (self runTestSuites: { aDTpluginConfiguration asTestSuite }); - yourself. - ^ aDTpluginConfiguration handleResults: results for: self -] - -{ #category : 'private' } -DTTestsRunnerPlugin >> runSuite: aTestSuite withResult: aResult [ - - aTestSuite when: TestAnnouncement do: [ :testAnnouncement | - self flag: #TODO. "Dirty" - testAnnouncement test class = TestSuite ifTrue: [ - self announceStatusChanged: - ('Running test {1}.' format: { testAnnouncement test name }) ] ] - for: self. - [ aResult mergeWith: (aTestSuite run) ] ensure: [ - aTestSuite unsubscribe: TestAnnouncement ] -] - -{ #category : 'private' } -DTTestsRunnerPlugin >> runTestSuites: testSuites [ - - | result | - result := TestAsserter classForTestResult new. - CurrentExecutionEnvironment runTestsBy: [ - testSuites - do: [ :testSuite | - | specificResult | - specificResult := testSuite resultClass new. - self runSuite: testSuite withResult: specificResult. - result mergeWith: specificResult ] - displayingProgress: 'Running Tests' ]. - result updateResultsInHistory. - ^ result -] - -{ #category : 'api' } -DTTestsRunnerPlugin >> secondListLabel [ - ^ 'Tests Cases' -] - -{ #category : 'api' } -DTTestsRunnerPlugin >> startButtonHelp [ - ^ 'Run tests selected.' translated -] - -{ #category : 'api' } -DTTestsRunnerPlugin >> startButtonLabel [ - ^ 'Run Tests' translated -] - -{ #category : 'tests' } -DTTestsRunnerPlugin >> testSuiteOf: aSetOfTest withName: aString [ - ^ aSetOfTest - collect: [ :each | - TestSuite new - in: [ :suite | - suite - addTest: each; - name: (self label: aString forSuite: suite) ]; - yourself ] -] diff --git a/src/DrTests-TestsRunner/DTTestsRunnerResult.class.st b/src/DrTests-TestsRunner/DTTestsRunnerResult.class.st deleted file mode 100644 index f92331de8b4..00000000000 --- a/src/DrTests-TestsRunner/DTTestsRunnerResult.class.st +++ /dev/null @@ -1,197 +0,0 @@ -" -I build a tree with the testsResult listed in groups: --Errors --Failures --Skipped tests --Passed test -I am used in DrTestsUI to show the results in a orderly manner. -" -Class { - #name : 'DTTestsRunnerResult', - #superclass : 'DTPluginResult', - #instVars : [ - 'testsResult' - ], - #category : 'DrTests-TestsRunner-Base', - #package : 'DrTests-TestsRunner', - #tag : 'Base' -} - -{ #category : 'accessing' } -DTTestsRunnerResult >> backgroundColorStyle [ - - testsResult errors ifNotEmpty: [ ^ 'testError' ]. - testsResult failures ifNotEmpty: [ ^ 'testFail' ]. - ^ 'testPass' -] - -{ #category : 'tree building' } -DTTestsRunnerResult >> buildLeavesFrom: aCollection type: testResultType [ - ^ aCollection collect: [ :t | DTTestLeafNode content: t type: testResultType ] -] - -{ #category : 'tree building' } -DTTestsRunnerResult >> buildNodeGroupedByTypeAndClass: anOrderedColletion type: testResultType [ - ^ DTTreeNode new - name: testResultType pluralName; - subResults: ((anOrderedColletion groupedBy: #class) associations collect: [ :assoc | - DTTreeNode new - name: assoc key name; - browseBlock: [ assoc key drTestsBrowse ]; - subResults: (self buildLeavesFrom: assoc value type: testResultType); - yourself ]); - yourself -] - -{ #category : 'tree building' } -DTTestsRunnerResult >> buildNodeGroupedByTypeClassAndProtocol: anOrderedColletion type: testResultType [ - ^ DTTreeNode new - name: testResultType pluralName; - subResults: ((anOrderedColletion groupedBy: #class) associations collect: [ :assoc | - DTTreeNode new - name: assoc key name; - subResults: ((assoc value groupedBy: [ :testCase | (testCase class lookupSelector: testCase selector) protocolName ]) associations collect: [ :protocolToTest | - DTTreeNode new - name: protocolToTest key; - subResults: (self buildLeavesFrom: protocolToTest value type: testResultType) ]); - yourself ]); - yourself -] - -{ #category : 'accessing' } -DTTestsRunnerResult >> buildTreeForUI [ - - ^ DTTreeNode new - subResults: { - DTTreeNode new - name: DTTestResultType error pluralName; - subResults: (self buildLeavesFrom: self errors type: DTTestResultType error); - startExpanded; - displayColorIfNotEmpty: TestResult defaultColorBackGroundForErrorTest; - yourself. - DTTreeNode new - name: DTTestResultType fail pluralName; - subResults: (self buildLeavesFrom: self failures type: DTTestResultType fail); - startExpanded; - displayColorIfNotEmpty: TestResult defaultColorBackGroundForFailureTest. - DTTreeNode new - name: DTTestResultType skipped pluralName; - subResults: (self buildLeavesFrom: self skipped type: DTTestResultType skipped). - DTTreeNode new - name: DTTestResultType pass pluralName; - subResults: (self buildLeavesFrom: self passed type: DTTestResultType pass); - displayColorIfNotEmpty: TestResult defaultColorBackGroundForPassingTest. - DTTreeNode new - name: DTTestResultType expectedFailure pluralName; - subResults: (self buildLeavesFrom: self expectedFailures type: DTTestResultType expectedFailure). - DTTreeNode new - name: DTTestResultType unexpectedPass pluralName; - subResults: (self buildLeavesFrom: self unexpectedPassed type: DTTestResultType unexpectedPass) }; - yourself -] - -{ #category : 'accessing' } -DTTestsRunnerResult >> buildTreeForUIByClasses [ - - - | errors failures skipped passed | - errors := self buildNodeGroupedByTypeAndClass: self testResults errors type: DTTestResultType error. - failures := self buildNodeGroupedByTypeAndClass: self testResults failures asOrderedCollection type: DTTestResultType fail. - skipped := self buildNodeGroupedByTypeAndClass: self testResults skipped type: DTTestResultType skipped. - passed := self buildNodeGroupedByTypeAndClass: self testResults passed type: DTTestResultType pass. - ^ DTTreeNode new - subResults: - {errors. - failures. - skipped. - passed}; - yourself -] - -{ #category : 'accessing' } -DTTestsRunnerResult >> buildTreeForUIByClassesAndProtocol [ - - - | errors failures skipped passed | - errors := self buildNodeGroupedByTypeClassAndProtocol: self testResults errors type: DTTestResultType error. - failures := self buildNodeGroupedByTypeClassAndProtocol: self testResults failures asOrderedCollection type: DTTestResultType fail. - skipped := self buildNodeGroupedByTypeClassAndProtocol: self testResults skipped type: DTTestResultType skipped. - passed := self buildNodeGroupedByTypeClassAndProtocol: self testResults passed type: DTTestResultType pass. - ^ DTTreeNode new - subResults: - {errors. - failures. - skipped. - passed}; - yourself -] - -{ #category : 'accessing' } -DTTestsRunnerResult >> errors [ - - ^ self testResults errors asOrderedCollection -] - -{ #category : 'accessing' } -DTTestsRunnerResult >> expectedFailures [ - ^ self testResults expectedDefects -] - -{ #category : 'accessing' } -DTTestsRunnerResult >> failures [ - ^ self testResults failures asOrderedCollection - select: [ :t | t shouldPass ] -] - -{ #category : 'accessing' } -DTTestsRunnerResult >> passed [ - ^ self testResults passed asOrderedCollection - select: [ :t | t shouldPass] -] - -{ #category : 'accessing' } -DTTestsRunnerResult >> skipped [ - ^ self testResults skipped -] - -{ #category : 'accessing' } -DTTestsRunnerResult >> summarizeInfo [ - "Text showed in miniDrTests with info of the result " - - ^ String - streamContents: [ :s | - s - print: self testResults passed size; - << ' passed'; - cr; - print: self testResults failures size; - << ' failures'; - cr; - print: self testResults errors size; - << ' errors'; - cr; - print: self testResults skipped size; - << ' skipped' ] -] - -{ #category : 'accessing' } -DTTestsRunnerResult >> testResults [ - ^ testsResult -] - -{ #category : 'accessing' } -DTTestsRunnerResult >> testResults: anObject [ - testsResult := anObject -] - -{ #category : 'accessing' } -DTTestsRunnerResult >> textColor [ - testsResult errors ifNotEmpty: [ ^ DTErrorResultType textColor ]. - testsResult failures ifNotEmpty: [ ^ DTFailResultType textColor ]. - ^ DTPassResultType textColor -] - -{ #category : 'accessing' } -DTTestsRunnerResult >> unexpectedPassed [ - ^ self testResults unexpectedPasses asOrderedCollection -] diff --git a/src/DrTests-TestsRunner/DTUnexpectedPassResultType.class.st b/src/DrTests-TestsRunner/DTUnexpectedPassResultType.class.st deleted file mode 100644 index 4d575d7d086..00000000000 --- a/src/DrTests-TestsRunner/DTUnexpectedPassResultType.class.st +++ /dev/null @@ -1,27 +0,0 @@ -" -I model the fact that a test expected to fail passed -" -Class { - #name : 'DTUnexpectedPassResultType', - #superclass : 'DTTestResultType', - #category : 'DrTests-TestsRunner-Results', - #package : 'DrTests-TestsRunner', - #tag : 'Results' -} - -{ #category : 'factory' } -DTUnexpectedPassResultType class >> backgroundColorStyle [ - - ^ 'testUnexpectedPass' -] - -{ #category : 'accessing' } -DTUnexpectedPassResultType >> isUnexpectedPass [ - - ^ true -] - -{ #category : 'accessing' } -DTUnexpectedPassResultType >> name [ - ^ 'Unexpected passed test' -] diff --git a/src/DrTests-TestsRunner/DrTestsPlugin.extension.st b/src/DrTests-TestsRunner/DrTestsPlugin.extension.st deleted file mode 100644 index b980b843291..00000000000 --- a/src/DrTests-TestsRunner/DrTestsPlugin.extension.st +++ /dev/null @@ -1,12 +0,0 @@ -Extension { #name : 'DrTestsPlugin' } - -{ #category : '*DrTests-TestsRunner' } -DrTestsPlugin >> buildReRunConfigurationFrom: aDrTests [ - "Builds a configuration for the plugin by reading the information held by the UI (aDrTests) and the last value of results." - - ^ DTReRunConfiguration new - originalConfiguration: aDrTests testsConfiguration; - previousResult: aDrTests pluginResult; - configurationToRun: (DTTestsRunnerConfiguration items: aDrTests contentForReRun); - yourself -] diff --git a/src/DrTests-TestsRunner/TestCase.extension.st b/src/DrTests-TestsRunner/TestCase.extension.st deleted file mode 100644 index fc2968d8beb..00000000000 --- a/src/DrTests-TestsRunner/TestCase.extension.st +++ /dev/null @@ -1,33 +0,0 @@ -Extension { #name : 'TestCase' } - -{ #category : '*DrTests-TestsRunner' } -TestCase >> asResultForDrTest [ - ^ DTTestLeafNode content: self -] - -{ #category : '*DrTests-TestsRunner' } -TestCase >> drTestsBrowse [ - - "May be using double dispatch would be better - so that the application of DrTest can open tools - without relying on this global." - - (Smalltalk tools toolNamed: #browser) - openOnClass: self class - selector: self selector -] - -{ #category : '*DrTests-TestsRunner' } -TestCase >> drTestsBuildContextMenu: aMenuModel [ - "Nothing to display yet." -] - -{ #category : '*DrTests-TestsRunner' } -TestCase >> drTestsName [ - ^ self asString -] - -{ #category : '*DrTests-TestsRunner' } -TestCase class >> drTestsSuite [ - ^ self suite -] diff --git a/src/DrTests-TestsRunner/package.st b/src/DrTests-TestsRunner/package.st deleted file mode 100644 index c195261572b..00000000000 --- a/src/DrTests-TestsRunner/package.st +++ /dev/null @@ -1 +0,0 @@ -Package { #name : 'DrTests-TestsRunner' } diff --git a/src/DrTests/AbstractDrTestsPresenter.class.st b/src/DrTests/AbstractDrTestsPresenter.class.st deleted file mode 100644 index f440face3c3..00000000000 --- a/src/DrTests/AbstractDrTestsPresenter.class.st +++ /dev/null @@ -1,204 +0,0 @@ -" -Abstract superclass for UI's of Dr Test -" -Class { - #name : 'AbstractDrTestsPresenter', - #superclass : 'StPresenter', - #instVars : [ - 'pluginResult', - 'testsConfiguration', - 'currentPlugin', - 'switchButton' - ], - #category : 'DrTests-Spec', - #package : 'DrTests', - #tag : 'Spec' -} - -{ #category : 'testing' } -AbstractDrTestsPresenter class >> isAbstract [ - - ^ self name = #AbstractDrTestsPresenter -] - -{ #category : 'icons' } -AbstractDrTestsPresenter class >> taskbarIconName [ - "Answer the icon for the receiver in a task bar." - - ^ #testRunner -] - -{ #category : 'accessing' } -AbstractDrTestsPresenter >> currentPlugin [ - - ^ currentPlugin -] - -{ #category : 'accessing' } -AbstractDrTestsPresenter >> currentPlugin: anObject [ - "If a plugin was set before, unsubscribe first." - - currentPlugin ifNotNil: [ currentPlugin unconfigureUI: self ]. - currentPlugin := anObject. - - currentPlugin announcer - when: DTStatusUpdate - send: #handlePluginStatusUpdate: - to: self. - - currentPlugin announcer - when: DTUpdateResults - send: #handlePluginResultUpdate: - to: self. - - titleHolder := self windowTitle. -] - -{ #category : 'events' } -AbstractDrTestsPresenter >> handlePluginResultUpdate: resultsAnnouncement [ - - self updateWithPluginResult: resultsAnnouncement results -] - -{ #category : 'announcement handling' } -AbstractDrTestsPresenter >> handlePluginStatusUpdate: aDTStatusUpdate [ - - self updateStatus: aDTStatusUpdate message -] - -{ #category : 'initialization' } -AbstractDrTestsPresenter >> initializeButtons [ - - switchButton := self newButton. - switchButton - action: [ self switchUI ]; - icon: (self iconNamed: #smallRemoteOpen) -] - -{ #category : 'initialization' } -AbstractDrTestsPresenter >> initializePresenters [ - - self initializeButtons -] - -{ #category : 'api - locking' } -AbstractDrTestsPresenter >> lock [ - "Lock the UI, once this method is called, the user is not able to click on buttons or lists anymore." - - self locked: false -] - -{ #category : 'api - locking' } -AbstractDrTestsPresenter >> locked: aBoolean [ - "Lock or unlock widgets returned by #subwidgetsToLock depending on aBoolean." - - self subwidgetsToLock - do: [ :subwidget | subwidget enabled: aBoolean ] -] - -{ #category : 'accessing' } -AbstractDrTestsPresenter >> pluginResult [ - - ^ pluginResult -] - -{ #category : 'accessing' } -AbstractDrTestsPresenter >> pluginResult: anObject [ - - pluginResult := anObject -] - -{ #category : 'running' } -AbstractDrTestsPresenter >> runPlugin [ - - self runPluginFor: self testsConfiguration -] - -{ #category : 'running' } -AbstractDrTestsPresenter >> runPluginFor: aTestsConfiguration [ - - [ self - lock; - updateStatus: 'Tests started.'; - updateWithResults: (self currentPlugin runForConfiguration: aTestsConfiguration); - updateStatus: 'Tests finished.' ] ensure: [ self unlock ] -] - -{ #category : 'api - locking' } -AbstractDrTestsPresenter >> subwidgetsToLock [ - - ^ { self startButton } -] - -{ #category : 'accessing' } -AbstractDrTestsPresenter >> switchButton [ - - ^ switchButton -] - -{ #category : 'accessing' } -AbstractDrTestsPresenter >> switchButton: anObject [ - - switchButton := anObject -] - -{ #category : 'api - subwidgets configuration' } -AbstractDrTestsPresenter >> switchButtonAction: aBlock [ - - self switchButton action: aBlock -] - -{ #category : 'actions' } -AbstractDrTestsPresenter >> switchUI [ - - self withWindowDo: [ :window | window close ] -] - -{ #category : 'accessing' } -AbstractDrTestsPresenter >> testsConfiguration [ - - ^ testsConfiguration -] - -{ #category : 'accessing' } -AbstractDrTestsPresenter >> testsConfiguration: anObject [ - - testsConfiguration := anObject -] - -{ #category : 'api - locking' } -AbstractDrTestsPresenter >> unlock [ - "Unlock the UI, once this method is called, the user is able to click on buttons or lists and to launch analysis." - - self locked: true -] - -{ #category : 'updating' } -AbstractDrTestsPresenter >> updateStatus: aString [ - "Does nothing on purpose." -] - -{ #category : 'updating' } -AbstractDrTestsPresenter >> updateUI [ - - self withWindowDo: [ :window | window title: self title ] -] - -{ #category : 'updating' } -AbstractDrTestsPresenter >> updateWithPluginResult: aPluginResult [ - - aPluginResult ifNil: [ ^ self ]. - self updateWithResults: aPluginResult -] - -{ #category : 'updating' } -AbstractDrTestsPresenter >> updateWithResults: results [ - - self subclassResponsibility -] - -{ #category : 'TOREMOVE' } -AbstractDrTestsPresenter >> windowIcon [ - - ^ self application iconNamed: #testRunner -] diff --git a/src/DrTests/ClassDescription.extension.st b/src/DrTests/ClassDescription.extension.st deleted file mode 100644 index 12d1c7e73aa..00000000000 --- a/src/DrTests/ClassDescription.extension.st +++ /dev/null @@ -1,10 +0,0 @@ -Extension { #name : 'ClassDescription' } - -{ #category : '*DrTests' } -ClassDescription >> drTestsBrowse [ - "May be using double dispatch would be better - so that the application of DrTest can open tools - without relying on this global." - - (Smalltalk tools toolNamed: #browser) openOnClass: self -] diff --git a/src/DrTests/CompiledMethod.extension.st b/src/DrTests/CompiledMethod.extension.st deleted file mode 100644 index 9a3d43cbf2c..00000000000 --- a/src/DrTests/CompiledMethod.extension.st +++ /dev/null @@ -1,18 +0,0 @@ -Extension { #name : 'CompiledMethod' } - -{ #category : '*DrTests' } -CompiledMethod >> asResultForDrTest [ - - ^ DTTestLeafNode content: self -] - -{ #category : '*DrTests' } -CompiledMethod >> drTestsBrowse [ - "May be using double dispatch would be better - so that the application of DrTest can open tools - without relying on this global." - - (Smalltalk tools toolNamed: #browser) - openOnClass: self methodClass - selector: self selector -] diff --git a/src/DrTests/DTAbstractTreeNode.class.st b/src/DrTests/DTAbstractTreeNode.class.st deleted file mode 100644 index 6a959c0afef..00000000000 --- a/src/DrTests/DTAbstractTreeNode.class.st +++ /dev/null @@ -1,55 +0,0 @@ -" -I am the abstract superclass for all classes that are nodes or leafs used to show results. -" -Class { - #name : 'DTAbstractTreeNode', - #superclass : 'Object', - #category : 'DrTests-Model', - #package : 'DrTests', - #tag : 'Model' -} - -{ #category : 'testing' } -DTAbstractTreeNode >> canBeBrowsed [ - ^ self subclassResponsibility -] - -{ #category : 'api' } -DTAbstractTreeNode >> displayColor [ - - ^ nil -] - -{ #category : 'actions' } -DTAbstractTreeNode >> drTestsBrowse [ - "Actions to perform in order to browse the result. - Does nothing by default." -] - -{ #category : 'menu' } -DTAbstractTreeNode >> drTestsBuildContextMenu: menu [ - "Builds the contextual menu to display in DrTests results tree when a node of the tree is right-clicked. - Does nothing by default." -] - -{ #category : 'accessing' } -DTAbstractTreeNode >> drTestsName [ - "Returns the name to display for this object in DrTestsUI." - ^ self subclassResponsibility -] - -{ #category : 'testing' } -DTAbstractTreeNode >> isLeaf [ - ^ false -] - -{ #category : 'testing' } -DTAbstractTreeNode >> shouldStartExpanded [ - - ^ false -] - -{ #category : 'accessing' } -DTAbstractTreeNode >> subResults [ - ^ #() -] diff --git a/src/DrTests/DTBrowseSelectedItemCommand.class.st b/src/DrTests/DTBrowseSelectedItemCommand.class.st deleted file mode 100644 index afef90b3876..00000000000 --- a/src/DrTests/DTBrowseSelectedItemCommand.class.st +++ /dev/null @@ -1,29 +0,0 @@ -" -I browse the item selected in middle list of DrTests. -" -Class { - #name : 'DTBrowseSelectedItemCommand', - #superclass : 'DTMiddleListCommand', - #category : 'DrTests-Commands', - #package : 'DrTests', - #tag : 'Commands' -} - -{ #category : 'defaults' } -DTBrowseSelectedItemCommand class >> defaultName [ - "Return the default name of the command" - - ^ 'Browse' -] - -{ #category : 'testing' } -DTBrowseSelectedItemCommand >> canBeExecuted [ - - ^ self selectedItems size = 1 -] - -{ #category : 'executing' } -DTBrowseSelectedItemCommand >> execute [ - - self context browseSelectedItem -] diff --git a/src/DrTests/DTCommand.class.st b/src/DrTests/DTCommand.class.st deleted file mode 100644 index e779c8d9029..00000000000 --- a/src/DrTests/DTCommand.class.st +++ /dev/null @@ -1,21 +0,0 @@ -" -I am an abstract command concerning DrTests. -" -Class { - #name : 'DTCommand', - #superclass : 'CmCommand', - #category : 'DrTests-Commands', - #package : 'DrTests', - #tag : 'Commands' -} - -{ #category : 'testing' } -DTCommand class >> isAbstract [ - - ^self name = #DTCommand -] - -{ #category : 'accessing' } -DTCommand >> plugin [ - ^ self context plugin -] diff --git a/src/DrTests/DTCoveragePluginPresenter.class.st b/src/DrTests/DTCoveragePluginPresenter.class.st deleted file mode 100644 index 7c355bd03fe..00000000000 --- a/src/DrTests/DTCoveragePluginPresenter.class.st +++ /dev/null @@ -1,162 +0,0 @@ -" -I am a specialized `DTDefaultPluginPresenter` for the DrTests coverage plugin. - -This subclass adds an extra panel to display the source code of the methods and highlight the covered lines of code. The highlighting has 3 colors where: -- green indicates fully covered lines. -- yellow indicates partially covered lines. -- red indicates uncovered lines. - -To achieve this, this subclass has 4 new attributes: sourceCodePanel, coveredNodes, uncoveredNodes, and yellowNodes. The sourceCodePanel is the panel that displays the highlighted source code below the list of method nodes. It also has 4 new methods: -1) `DTCoveragePluginPresenter>>#updateSourceCodePanel:` updates the panel when the user clicks on a method in the result list. It colors in the order they are presented above, starting from green as a base color. -2) `DTCoveragePluginPresenter>>#defineColorCoverage:` updates the coveredNodes and uncoveredNodes attributes according to the selected method. -3) `DTCoveragePluginPresenter>>#defineColorMessageNode:` updates the yellowNodes attribute according to the selected method. If an ASTMessageNode contains selectors with block arguments like `ifTrue:`, `ifFalse:`, `do:` and others, it decides whether they should be highlighted in yellow or green. -4) `DTCoveragePluginPresenter>>#addHighlightingOf:withColor:` applies the highlighting to the source code panel for each attribute (coveredNodes, uncoveredNodes, and yellowNodes). -" -Class { - #name : 'DTCoveragePluginPresenter', - #superclass : 'DTDefaultPluginPresenter', - #instVars : [ - 'sourceCodePanel', - 'coveredNodes', - 'uncoveredNodes', - 'yellowNodes' - ], - #category : 'DrTests-Spec', - #package : 'DrTests', - #tag : 'Spec' -} - -{ #category : 'highlighting' } -DTCoveragePluginPresenter >> addHighlightingOf: nodesCollection withColor: aColor [ - - nodesCollection do: [ :node | - sourceCodePanel addTextSegmentDecoration: - (SpTextPresenterDecorator forHighlight - interval: - (node sourceInterval first to: node sourceInterval last + 1); - highlightColor: aColor) ] -] - -{ #category : 'initialization' } -DTCoveragePluginPresenter >> cleanAttributesForHighlighting [ - " Clean the attributes to store new value to display on Source Code panel " - - yellowNodes := OrderedCollection new. - uncoveredNodes := OrderedCollection new. - coveredNodes := OrderedCollection new -] - -{ #category : 'initialization' } -DTCoveragePluginPresenter >> connectPresenters [ - - super connectPresenters. - - self resultViewsDropList whenSelectedItemChangedDo: [ - :resultTreeViewOrNil | - resultTreeViewOrNil ifNotNil: [ - resultsList roots: - (resultTreeViewOrNil resultTreeFor: drTests pluginResult) - subResults ] ]. - - resultsList whenSelectionChangedDo: [ :selection | - (selection selectedItem isKindOf: DTTestLeafNode) ifTrue: [ - selection selectedItem ifNotNil: [ :item | - self updateSourceCodePanel: item content ] ] ] -] - -{ #category : 'layout' } -DTCoveragePluginPresenter >> defaultLayout [ - - ^ SpBoxLayout newTopToBottom - add: (SpPanedLayout newLeftToRight - add: (SpPanedLayout newLeftToRight - add: packagesList; - add: itemsList; - yourself); - add: (SpBoxLayout newTopToBottom - spacing: 5; - add: resultViewsDropList expand: false; - add: resultLabel expand: false; - add: resultsList; - add: sourceCodePanel; - yourself); - yourself); - add: startButton expand: false; - yourself -] - -{ #category : 'highlighting' } -DTCoveragePluginPresenter >> defineColorCoverage: aMethod [ - - aMethod ast nodesDo: [ :node | - node isSequence ifTrue: [ - node hasBeenExecuted - ifTrue: [ - (self hasSequenceNodeInside: node) ifFalse: [ - coveredNodes add: node ] ] - ifFalse: [ uncoveredNodes add: node ] ]. - - node isMessage ifTrue: [ self defineColorMessageNode: node ] ] -] - -{ #category : 'highlighting' } -DTCoveragePluginPresenter >> defineColorMessageNode: aMessageNode [ - "handle arguments of an ASTMessageNode" - - | blockNodes | - blockNodes := aMessageNode arguments select: [ :element | - element isBlock ]. - blockNodes ifNotEmpty: [ - (blockNodes allSatisfy: [ :arg | arg body hasBeenExecuted ]) - ifFalse: [ yellowNodes add: aMessageNode . ] ] -] - -{ #category : 'highlighting' } -DTCoveragePluginPresenter >> hasSequenceNodeInside: aSequenceNode [ - - ^ aSequenceNode statements anySatisfy: [ :statement | - statement allChildren anySatisfy: [ :node | node isSequence ] ] -] - -{ #category : 'initialization' } -DTCoveragePluginPresenter >> initializeResultsTreeAndLabel [ - - resultLabel := self newLabel label: 'Results:'. - resultsList := self newTree. - resultsList - display: [ :node | node drTestsName ]; - displayColor: [ :node | node displayColor ]; - children: [ :node | node subResults ]; - actions: self rootCommandsGroup / 'Results tools'. - - resultsList outputActivationPort transmitDo: [ - (DTResultBrowseCommand forSpecContext: self) execute ]. - sourceCodePanel := self instantiate: SpCodePresenter . -] - -{ #category : 'layout' } -DTCoveragePluginPresenter >> updateSourceCodePanel: compiledMethod [ - " The colors overlap and paint in descending order" - - self cleanAttributesForHighlighting. - self defineColorCoverage: compiledMethod. - sourceCodePanel beForMethod: compiledMethod. - sourceCodePanel text: compiledMethod sourceCode. - self - addHighlightingOf: coveredNodes - withColor: (Color r: 0.74 g: 0.98 b: 0.71). - self - addHighlightingOf: uncoveredNodes - withColor: (Color r: 0.98 g: 0.71 b: 0.71). - self - addHighlightingOf: yellowNodes - withColor: (Color r: 0.98 g: 0.95 b: 0.71). - - "Base color is green" - sourceCodePanel addTextSegmentDecoration: - (SpTextPresenterDecorator forHighlight - interval: (compiledMethod ast body sourceInterval first to: - compiledMethod ast body sourceInterval last + 1); - highlightColor: (Color r: 0.74 g: 0.98 b: 0.71)). - ^ sourceCodePanel yourself -] diff --git a/src/DrTests/DTDefaultPluginPresenter.class.st b/src/DrTests/DTDefaultPluginPresenter.class.st deleted file mode 100644 index 0166d6086ed..00000000000 --- a/src/DrTests/DTDefaultPluginPresenter.class.st +++ /dev/null @@ -1,448 +0,0 @@ -Class { - #name : 'DTDefaultPluginPresenter', - #superclass : 'SpPresenter', - #instVars : [ - 'packagesList', - 'resultsList', - 'itemsList', - 'resultViewsDropList', - 'resultLabel', - 'plugin', - 'drTests', - 'lastResults', - 'startButton' - ], - #category : 'DrTests-Spec', - #package : 'DrTests', - #tag : 'Spec' -} - -{ #category : 'commands' } -DTDefaultPluginPresenter class >> buildCommandsGroupWith: presenterInstance forRoot: rootCommandGroup [ - - rootCommandGroup - register: (self buildContextualPackageGroupWith: presenterInstance); - register: (self buildItemsListGroupWith: presenterInstance); - register: (self buildResultGroupWith: presenterInstance) -] - -{ #category : 'private - commands' } -DTDefaultPluginPresenter class >> buildContextualPackageGroupWith: presenterInstance [ - - ^ (CmCommandGroup named: 'Package menu') asSpecGroup - register: (self buildPackageGroupWith: presenterInstance); - yourself -] - -{ #category : 'private - commands' } -DTDefaultPluginPresenter class >> buildItemsListGroupWith: presenterInstance [ - - ^ (CmCommandGroup named: 'List items menu') asSpecGroup - register: - (DTInspectSelectedItemCommand forSpecContext: presenterInstance) - beHiddenWhenCantBeRun; - register: - (DTBrowseSelectedItemCommand forSpec context: presenterInstance); - yourself -] - -{ #category : 'private - commands' } -DTDefaultPluginPresenter class >> buildPackageGroupWith: presenterInstance [ - - |group| - group := (CmCommandGroup named: 'Package tools') asSpecGroup. - group description: 'Commands related to packages list.'. - - DTPackagesCommand allSubclasses do: [:each | - group register: (each forSpec context: presenterInstance) ]. - - ^group - beDisplayedAsGroup; - yourself -] - -{ #category : 'private - commands' } -DTDefaultPluginPresenter class >> buildResultGroupWith: presenterInstance [ - - | commandGroup pluginCommands plugin | - commandGroup := (CmCommandGroup named: 'Results tools') asSpecGroup - description: 'Commands related to result.'; - register: - (DTResultBrowseCommand forSpecContext: - presenterInstance) beHiddenWhenCantBeRun; - yourself. - - plugin := presenterInstance plugin. - plugin ifNil: [ ^ commandGroup ]. - - pluginCommands := plugin buildContextualMenuGroupWith: - presenterInstance. - pluginCommands entries ifEmpty: [ ^ commandGroup ]. - ^ commandGroup - register: pluginCommands beDisplayedAsGroup; - yourself -] - -{ #category : 'actions' } -DTDefaultPluginPresenter >> browseSelectedItem [ - "Because of DTBrowseSelectedItem>>#canBeExecuted, we know there is a single item in the selection. - Thus, we take the first one and browse it. - " - - self selectedItems first drTestsBrowse -] - -{ #category : 'actions' } -DTDefaultPluginPresenter >> browseSelectedPackage [ - - self selectedPackage browse -] - -{ #category : 'actions' } -DTDefaultPluginPresenter >> browseSelectedResult [ - - self resultSelected drTestsBrowse -] - -{ #category : 'private' } -DTDefaultPluginPresenter >> buildLabelString: nameOfItems numberOfItemsSelected: aInt [ - - ^ String streamContents: [ :stream | - stream - << nameOfItems; - << ' ('; - << aInt asString; - << ' selected):' ] -] - -{ #category : 'initialization' } -DTDefaultPluginPresenter >> connectPresenters [ - - super connectPresenters. - - self resultViewsDropList - whenSelectedItemChangedDo: [ :resultTreeViewOrNil | - resultTreeViewOrNil - ifNotNil: [ resultsList - roots: (resultTreeViewOrNil resultTreeFor: drTests pluginResult) subResults ] ] -] - -{ #category : 'layout' } -DTDefaultPluginPresenter >> defaultLayout [ - - ^ SpBoxLayout newTopToBottom - add: (SpPanedLayout newLeftToRight - add: (SpPanedLayout newLeftToRight - add: packagesList; - add: itemsList; - yourself); - add: (SpBoxLayout newTopToBottom - spacing: 5; - add: resultViewsDropList expand: false; - add: resultLabel expand: false; - add: resultsList; - yourself); - yourself); - add: startButton expand: false; - yourself -] - -{ #category : 'accessing' } -DTDefaultPluginPresenter >> drTests [ - ^ drTests -] - -{ #category : 'initialization' } -DTDefaultPluginPresenter >> initializeItemsListAndLabel [ - - itemsList := self newFilterableTreePresenter. - itemsList - displayIcon: [ :aClass | self iconNamed: aClass systemIconName ]; - displayColor: [ :aClass | - (self packagesSelected includes: aClass package) - ifTrue: [ self theme textColor ] - ifFalse: [ self theme classExtensionColor ] ]; - help: - 'Select the classes to analyze. Cmd+A or Ctrl+A to select all classes.'; - displayBlock: [ :item | item name ]; - whenSelectionChangedDo: [ - self whenItemsSelectionChanged: self selectedItems ]; - beMultipleSelection; - actions: (self rootCommandsGroup / 'List items menu') beRoot. - - packagesList whenSelectionChangedDo: [ - self whenPackagesSelectionChanged: self packagesSelected ] -] - -{ #category : 'initialization' } -DTDefaultPluginPresenter >> initializePackagesListAndLabel [ - - packagesList := self newFilterableListPresenter. - packagesList - help: 'Select the packages to analyze. Cmd+A or Ctrl+A to select all packages.'; - sortingBlock: #name ascending; - displayBlock: [ :package | package name ]; - beMultipleSelection; - actions: self rootCommandsGroup / 'Package menu' -] - -{ #category : 'initialization' } -DTDefaultPluginPresenter >> initializePresenters [ - - super initializePresenters. - - self - initializePackagesListAndLabel; - initializeItemsListAndLabel; - initializeResultsTreeAndLabel; - initializeResultViewsDropList. - - startButton := self newButton. - startButton action: [ drTests runPlugin ] -] - -{ #category : 'initialization' } -DTDefaultPluginPresenter >> initializeResultViewsDropList [ - - resultViewsDropList := self newDropList. - self resultViewsDropList - help: 'Select the different views for results'; - display: [ :resultTreeView | resultTreeView name ] -] - -{ #category : 'initialization' } -DTDefaultPluginPresenter >> initializeResultsTreeAndLabel [ - - resultLabel := self newLabel label: 'Results:'. - resultsList := self newTree. - resultsList - display: [ :node | node drTestsName ]; - displayColor: [ :node | node displayColor ]; - children: [ :node | node subResults ]; - actions: self rootCommandsGroup / 'Results tools'. - - resultsList outputActivationPort - transmitDo: [ - (DTResultBrowseCommand forSpecContext: self) execute ] -] - -{ #category : 'actions' } -DTDefaultPluginPresenter >> inspectSelectedItem [ - - self selectedItems first inspect -] - -{ #category : 'actions' } -DTDefaultPluginPresenter >> inspectSelectedPackage [ - - self selectedPackage inspect -] - -{ #category : 'accessing' } -DTDefaultPluginPresenter >> itemsList [ - ^ itemsList -] - -{ #category : 'widgets' } -DTDefaultPluginPresenter >> newFilterableListPresenter [ - - ^ self instantiate: DTFilterableListPresenter -] - -{ #category : 'widgets' } -DTDefaultPluginPresenter >> newFilterableTreePresenter [ - - ^ self instantiate: DTFilterableTreePresenter -] - -{ #category : 'accessing' } -DTDefaultPluginPresenter >> packagesList [ - ^ packagesList -] - -{ #category : 'private' } -DTDefaultPluginPresenter >> packagesSelected [ - - ^ self packagesList ifNil: [ #( ) ] ifNotNil: #selectedItems -] - -{ #category : 'accessing' } -DTDefaultPluginPresenter >> plugin [ - ^ plugin -] - -{ #category : 'accessing' } -DTDefaultPluginPresenter >> resultSelected [ - - ^ self resultsList selectedItem -] - -{ #category : 'api' } -DTDefaultPluginPresenter >> resultTree: aResultGroup [ - - | roots | - aResultGroup ifNil: [ ^ self ]. - roots := aResultGroup subResults. - resultsList roots: roots. - roots withIndexDo: [ :each :index | - each shouldStartExpanded ifTrue: [ - "here there was a each name crTrace. - It does not look like the good way to provide feedback in the transcript" - resultsList expandPath: { index } ] ] -] - -{ #category : 'accessing' } -DTDefaultPluginPresenter >> resultViewsDropList [ - ^ resultViewsDropList -] - -{ #category : 'accessing' } -DTDefaultPluginPresenter >> resultsList [ - ^ resultsList -] - -{ #category : 'api' } -DTDefaultPluginPresenter >> selectAllInPackageList [ - - packagesList selectAll -] - -{ #category : 'api' } -DTDefaultPluginPresenter >> selectNoneInPackageList [ - - packagesList unselectAll -] - -{ #category : 'accessing' } -DTDefaultPluginPresenter >> selectedItems [ - - ^ itemsList selectedItems -] - -{ #category : 'accessing' } -DTDefaultPluginPresenter >> selectedPackage [ - - ^ packagesList selectedItem -] - -{ #category : 'accessing' } -DTDefaultPluginPresenter >> setModelBeforeInitialization: aPair [ - - plugin := aPair first. - drTests := aPair second -] - -{ #category : 'accessing' } -DTDefaultPluginPresenter >> startButton [ - ^ startButton -] - -{ #category : 'accessing' } -DTDefaultPluginPresenter >> subwidgetsToLock [ - - ^ { packagesList. itemsList. resultsList. startButton} -] - -{ #category : 'private - updating' } -DTDefaultPluginPresenter >> updateItemsListLabel [ - - itemsList label: (self - buildLabelString: plugin secondListLabel - numberOfItemsSelected: self selectedItems size) -] - -{ #category : 'private - updating' } -DTDefaultPluginPresenter >> updatePackagesList [ - - packagesList unselectAll. - itemsList beEmpty. - packagesList items: plugin packagesAvailableForAnalysis. - packagesList label: plugin firstListLabel. - itemsList label: plugin secondListLabel. - plugin setSelectionModeOfPackageList: packagesList. - plugin setSelectionModeOfItemsList: itemsList -] - -{ #category : 'private - updating' } -DTDefaultPluginPresenter >> updatePackagesListLabel [ - - self packagesList label: (self - buildLabelString: plugin firstListLabel - numberOfItemsSelected: self packagesSelected size) -] - -{ #category : 'initialization' } -DTDefaultPluginPresenter >> updatePresenter [ - - super updatePresenter. - - self updatePackagesList. - self updateResultViewsDropList. - - startButton label: plugin startButtonLabel. - startButton help: plugin startButtonHelp -] - -{ #category : 'updating' } -DTDefaultPluginPresenter >> updateResultLabel [ - - resultLabel styles copy - do: [ :each | resultLabel removeStyle: each ]. - resultLabel - label: 'Results:'; - addStyle: lastResults backgroundColorStyle -] - -{ #category : 'updating' } -DTDefaultPluginPresenter >> updateResultViewsDropList [ - | newPragmas | - - newPragmas := plugin resultTreeViews. - (resultViewsDropList listItems = newPragmas - and: [ newPragmas isNotEmpty ]) - ifTrue: [ - "Trigger action attached to selection change." - resultViewsDropList selectedIndex: resultViewsDropList selectedIndex. - ^ self ]. - - self resultViewsDropList selectedItem - ifNotNil: [ self resultViewsDropList resetSelection ]. - self resultViewsDropList items: newPragmas. - newPragmas isNotEmpty - ifTrue: [ self resultViewsDropList selectIndex: 1 ] -] - -{ #category : 'updating' } -DTDefaultPluginPresenter >> updateWithResults: someResults [ - - lastResults := someResults. - - self updateResultViewsDropList. - self updateResultLabel. - self resultTree: lastResults buildTreeForUI. - resultsList actions: self rootCommandsGroup / 'Results tools' -] - -{ #category : 'private' } -DTDefaultPluginPresenter >> whenItemsSelectionChanged: itemsSelected [ - - self updateItemsListLabel. - drTests updateSwitchButton: itemsSelected -] - -{ #category : 'private' } -DTDefaultPluginPresenter >> whenPackagesSelectionChanged: packagesSelected [ - - itemsList - roots: ((plugin itemsToBeAnalysedFor: packagesSelected) sorted: - #name ascending); - children: [ :aClass | - aClass subclasses - & (packagesSelected flatCollect: [ :package | package classes ]) - sorted: #name ascending ]; - expandAll. - itemsList roots: itemsList items. - - itemsList selectAll. - self updatePackagesListLabel -] diff --git a/src/DrTests/DTFilterableListPresenter.class.st b/src/DrTests/DTFilterableListPresenter.class.st deleted file mode 100644 index 2b17bc4e434..00000000000 --- a/src/DrTests/DTFilterableListPresenter.class.st +++ /dev/null @@ -1,249 +0,0 @@ -" -I am a list presenter that can be filtered. - -I also have a label. -" -Class { - #name : 'DTFilterableListPresenter', - #superclass : 'SpPresenter', - #instVars : [ - 'listPresenter', - 'filterTextInput', - 'initialItems', - 'labelPresenter' - ], - #category : 'DrTests-Spec', - #package : 'DrTests', - #tag : 'Spec' -} - -{ #category : 'api - actions' } -DTFilterableListPresenter >> actions [ - - ^ self listPresenter actions -] - -{ #category : 'api - actions' } -DTFilterableListPresenter >> actions: aCommandGroup [ - - self listPresenter actions: aCommandGroup -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> allItems [ - - ^ initialItems -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> beEmpty [ - - self items: #() -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> beMultipleSelection [ - - ^ self listPresenter beMultipleSelection -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> beSingleSelection [ - - ^ self listPresenter beSingleSelection -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> contextMenu: aBlock [ - - ^ self listPresenter contextMenu: aBlock -] - -{ #category : 'layout' } -DTFilterableListPresenter >> defaultLayout [ - - ^ SpBoxLayout newTopToBottom - spacing: 5; - add: labelPresenter expand: false; - add: listPresenter; - add: filterTextInput expand: false; - yourself -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> displayBlock: aBlock [ - - ^ self listPresenter display: aBlock -] - -{ #category : 'api' } -DTFilterableListPresenter >> displayColor: aBlock [ - - self listPresenter displayColor: aBlock -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> displayIcon: aFullBlockClosure [ - - self listPresenter displayIcon: aFullBlockClosure -] - -{ #category : 'private - actions' } -DTFilterableListPresenter >> ensureActions [ - - ^ self listPresenter ensureActions -] - -{ #category : 'private' } -DTFilterableListPresenter >> filterList [ - "Filters the list according to the filterTextInput." - - self unselectAll. - self filterStrings - ifEmpty: [ - self listPresenter - items: initialItems. - ^ self ]. - self listPresenter - items: - (initialItems - select: [ :each | - self filterStrings - anySatisfy: [ :any | any match: (self listPresenter display value: each) ] ]) -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> filterStrings [ - - ^ (self filterTextInput text splitOn: $|) - reject: #isEmpty - thenCollect: [ :pattern | '*' , pattern , '*' ] -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> filterTextInput [ - - ^ filterTextInput -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> help [ - - ^ labelPresenter help -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> help: aString [ - - labelPresenter help: aString -] - -{ #category : 'initialization' } -DTFilterableListPresenter >> initialize [ - - super initialize. - initialItems := #() -] - -{ #category : 'initialization' } -DTFilterableListPresenter >> initializePresenters [ - - labelPresenter := self newLabel. - listPresenter := self newList. - filterTextInput := self newTextInput - placeholder: 'Filter...'; - whenTextChangedDo: [ self filterList ]; - yourself -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> items [ - - ^ self visibleItems -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> items: items [ - - initialItems := items. - self listPresenter items: items -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> label [ - - ^ labelPresenter label -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> label: aString [ - - labelPresenter label: aString -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> labelPresenter [ - - ^ labelPresenter -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> listPresenter [ - - ^ listPresenter -] - -{ #category : 'actions' } -DTFilterableListPresenter >> resetFilter [ - - self filterTextInput text: ''. - self listPresenter items: initialItems -] - -{ #category : 'actions' } -DTFilterableListPresenter >> selectAll [ - - ^ self listPresenter selectAll -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> selectItems: aBlock [ - - ^ self listPresenter selectItems: aBlock -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> selectedItem [ - - ^ listPresenter selectedItem -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> selectedItems [ - - ^ self listPresenter selectedItems -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> sortingBlock: aBlock [ - - ^ self listPresenter sortingBlock: aBlock -] - -{ #category : 'actions' } -DTFilterableListPresenter >> unselectAll [ - - ^ self listPresenter unselectAll -] - -{ #category : 'accessing' } -DTFilterableListPresenter >> visibleItems [ - - ^ self listPresenter items -] - -{ #category : 'events' } -DTFilterableListPresenter >> whenSelectionChangedDo: aBlock [ - - ^ self listPresenter whenSelectionChangedDo: aBlock -] diff --git a/src/DrTests/DTFilterableTreePresenter.class.st b/src/DrTests/DTFilterableTreePresenter.class.st deleted file mode 100644 index c48d9672124..00000000000 --- a/src/DrTests/DTFilterableTreePresenter.class.st +++ /dev/null @@ -1,256 +0,0 @@ -" -I am a list presenter that can be filtered. - -I also have a label. -" -Class { - #name : 'DTFilterableTreePresenter', - #superclass : 'SpPresenter', - #instVars : [ - 'treePresenter', - 'filterTextInput', - 'initialItems', - 'labelPresenter' - ], - #category : 'DrTests-Spec', - #package : 'DrTests', - #tag : 'Spec' -} - -{ #category : 'api - actions' } -DTFilterableTreePresenter >> actions [ - - ^ self treePresenter actions -] - -{ #category : 'api - actions' } -DTFilterableTreePresenter >> actions: aCommandGroup [ - - self treePresenter actions: aCommandGroup -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> allItems [ - - ^ initialItems -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> beEmpty [ - - self roots: #() -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> beMultipleSelection [ - - ^ self treePresenter beMultipleSelection -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> beSingleSelection [ - - ^ self treePresenter beSingleSelection -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> children [ - - ^ self treePresenter children -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> children: aBlock [ - - self treePresenter children: aBlock -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> contextMenu: aBlock [ - - ^ self treePresenter contextMenu: aBlock -] - -{ #category : 'layout' } -DTFilterableTreePresenter >> defaultLayout [ - - ^ SpBoxLayout newTopToBottom - spacing: 5; - add: labelPresenter expand: false; - add: treePresenter; - add: filterTextInput expand: false; - yourself -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> displayBlock: aBlock [ - - ^ self treePresenter display: aBlock -] - -{ #category : 'api' } -DTFilterableTreePresenter >> displayColor: aBlock [ - - self treePresenter displayColor: aBlock -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> displayIcon: aFullBlockClosure [ - - self treePresenter displayIcon: aFullBlockClosure -] - -{ #category : 'private - actions' } -DTFilterableTreePresenter >> ensureActions [ - - ^ self treePresenter ensureActions -] - -{ #category : 'expanding-collapsing' } -DTFilterableTreePresenter >> expandAll [ - - self treePresenter expandAll -] - -{ #category : 'private' } -DTFilterableTreePresenter >> filterList [ - "Filters the list according to the filterTextInput." - - self unselectAll. - self filterStrings ifEmpty: [ - self roots: initialItems. - ^ self ]. - self roots: (initialItems select: [ :each | - self filterStrings anySatisfy: [ :any | - any match: (self treePresenter display value: each) ] ]) -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> filterStrings [ - - ^ (self filterTextInput text splitOn: $|) - reject: #isEmpty - thenCollect: [ :pattern | '*' , pattern , '*' ] -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> filterTextInput [ - - ^ filterTextInput -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> help [ - - ^ labelPresenter help -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> help: aString [ - - labelPresenter help: aString -] - -{ #category : 'initialization' } -DTFilterableTreePresenter >> initialize [ - - super initialize. - initialItems := #() -] - -{ #category : 'initialization' } -DTFilterableTreePresenter >> initializePresenters [ - - labelPresenter := self newLabel. - treePresenter := self newTree. - filterTextInput := self newTextInput - placeholder: 'Filter...'; - whenTextChangedDo: [ self filterList ]; - yourself -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> items [ - - ^ self visibleItems -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> label [ - - ^ labelPresenter label -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> label: aString [ - - labelPresenter label: aString -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> labelPresenter [ - - ^ labelPresenter -] - -{ #category : 'actions' } -DTFilterableTreePresenter >> resetFilter [ - - self filterTextInput text: ''. - self treePresenter roots: initialItems -] - -{ #category : 'api' } -DTFilterableTreePresenter >> roots: aBlock [ - - initialItems := aBlock. - self treePresenter roots: aBlock -] - -{ #category : 'actions' } -DTFilterableTreePresenter >> selectAll [ - - ^ self treePresenter selectAll -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> selectItems: aBlock [ - - ^ self treePresenter selectItems: aBlock -] - -{ #category : 'api - selection' } -DTFilterableTreePresenter >> selectPaths: aPathArray [ - - self treePresenter selectPaths: aPathArray -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> selectedItems [ - - ^ self treePresenter selectedItems -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> treePresenter [ - - ^ treePresenter -] - -{ #category : 'actions' } -DTFilterableTreePresenter >> unselectAll [ - - ^ self treePresenter unselectAll -] - -{ #category : 'accessing' } -DTFilterableTreePresenter >> visibleItems [ - - ^ self treePresenter roots -] - -{ #category : 'events' } -DTFilterableTreePresenter >> whenSelectionChangedDo: aBlock [ - - ^ self treePresenter whenSelectionChangedDo: aBlock -] diff --git a/src/DrTests/DTInspectSelectedItemCommand.class.st b/src/DrTests/DTInspectSelectedItemCommand.class.st deleted file mode 100644 index 6eaf53e334d..00000000000 --- a/src/DrTests/DTInspectSelectedItemCommand.class.st +++ /dev/null @@ -1,22 +0,0 @@ -" -I browse the selected result in the results list of DrTests. -" -Class { - #name : 'DTInspectSelectedItemCommand', - #superclass : 'DTMiddleListCommand', - #category : 'DrTests-Commands', - #package : 'DrTests', - #tag : 'Commands' -} - -{ #category : 'default' } -DTInspectSelectedItemCommand class >> defaultName [ - - ^ 'Inspect' -] - -{ #category : 'executing' } -DTInspectSelectedItemCommand >> execute [ - - self context inspectSelectedItem -] diff --git a/src/DrTests/DTLeafResultCommand.class.st b/src/DrTests/DTLeafResultCommand.class.st deleted file mode 100644 index 9463bc2851b..00000000000 --- a/src/DrTests/DTLeafResultCommand.class.st +++ /dev/null @@ -1,21 +0,0 @@ -" -I am an abstract command concerning DrTests' results tree but I can only be executed if a leaf is selected by user. -" -Class { - #name : 'DTLeafResultCommand', - #superclass : 'DTResultCommand', - #category : 'DrTests-Commands', - #package : 'DrTests', - #tag : 'Commands' -} - -{ #category : 'testing' } -DTLeafResultCommand class >> isAbstract [ - - ^ self name = #DTLeafResultCommand -] - -{ #category : 'hooks' } -DTLeafResultCommand >> canBeRun [ - ^ self resultSelected isLeaf -] diff --git a/src/DrTests/DTLeavesCollector.class.st b/src/DrTests/DTLeavesCollector.class.st deleted file mode 100644 index 22a8a2806fd..00000000000 --- a/src/DrTests/DTLeavesCollector.class.st +++ /dev/null @@ -1,43 +0,0 @@ -" -I am a visitor that collect the leaves of the DTTreeNode I visit. - -If there are multiple levels of DTTreeNode, no problem, I traverse them until I find the leaves. -" -Class { - #name : 'DTLeavesCollector', - #superclass : 'DTResultsTreeVisitor', - #instVars : [ - 'leaves' - ], - #category : 'DrTests-Visitors', - #package : 'DrTests', - #tag : 'Visitors' -} - -{ #category : 'instance creation' } -DTLeavesCollector class >> collectLeavesOf: aDTTreeNode [ - ^ self new - visit: aDTTreeNode; - leaves -] - -{ #category : 'initialization' } -DTLeavesCollector >> initialize [ - super initialize. - leaves := OrderedCollection new -] - -{ #category : 'accessing' } -DTLeavesCollector >> leaves [ - ^ leaves -] - -{ #category : 'accessing' } -DTLeavesCollector >> leaves: anObject [ - leaves := anObject -] - -{ #category : 'visiting' } -DTLeavesCollector >> visitDTTreeLeaf: aDTTreeLeaf [ - self leaves add: aDTTreeLeaf -] diff --git a/src/DrTests/DTMiddleListCommand.class.st b/src/DrTests/DTMiddleListCommand.class.st deleted file mode 100644 index 84d36a34ec4..00000000000 --- a/src/DrTests/DTMiddleListCommand.class.st +++ /dev/null @@ -1,22 +0,0 @@ -" -I am an abstract command concerning DrTests' middle list. -" -Class { - #name : 'DTMiddleListCommand', - #superclass : 'DTCommand', - #category : 'DrTests-Commands', - #package : 'DrTests', - #tag : 'Commands' -} - -{ #category : 'testing' } -DTMiddleListCommand class >> isAbstract [ - - ^ self name = #DTMiddleListCommand -] - -{ #category : 'accessing' } -DTMiddleListCommand >> selectedItems [ - - ^ self context selectedItems -] diff --git a/src/DrTests/DTNullPluginPresenter.class.st b/src/DrTests/DTNullPluginPresenter.class.st deleted file mode 100644 index b45c216aa27..00000000000 --- a/src/DrTests/DTNullPluginPresenter.class.st +++ /dev/null @@ -1,17 +0,0 @@ -Class { - #name : 'DTNullPluginPresenter', - #superclass : 'SpPresenter', - #category : 'DrTests-Spec', - #package : 'DrTests', - #tag : 'Spec' -} - -{ #category : 'layout' } -DTNullPluginPresenter >> defaultLayout [ - - ^ SpBoxLayout newHorizontal -] - -{ #category : 'updating' } -DTNullPluginPresenter >> updateUI [ -] diff --git a/src/DrTests/DTPackagesBrowseCommand.class.st b/src/DrTests/DTPackagesBrowseCommand.class.st deleted file mode 100644 index 54db0c5d24f..00000000000 --- a/src/DrTests/DTPackagesBrowseCommand.class.st +++ /dev/null @@ -1,22 +0,0 @@ -" -I browse the selected package in the package list of DrTests. -" -Class { - #name : 'DTPackagesBrowseCommand', - #superclass : 'DTPackagesCommand', - #category : 'DrTests-Commands', - #package : 'DrTests', - #tag : 'Commands' -} - -{ #category : 'default' } -DTPackagesBrowseCommand class >> defaultName [ - - ^ 'Browse' -] - -{ #category : 'executing' } -DTPackagesBrowseCommand >> execute [ - - self context browseSelectedPackage -] diff --git a/src/DrTests/DTPackagesCommand.class.st b/src/DrTests/DTPackagesCommand.class.st deleted file mode 100644 index a94761a811b..00000000000 --- a/src/DrTests/DTPackagesCommand.class.st +++ /dev/null @@ -1,16 +0,0 @@ -" -I am an abstract command concerning DrTests' package list. -" -Class { - #name : 'DTPackagesCommand', - #superclass : 'DTCommand', - #category : 'DrTests-Commands', - #package : 'DrTests', - #tag : 'Commands' -} - -{ #category : 'testing' } -DTPackagesCommand class >> isAbstract [ - - ^ self name = #DTPackagesCommand -] diff --git a/src/DrTests/DTPackagesInspectCommand.class.st b/src/DrTests/DTPackagesInspectCommand.class.st deleted file mode 100644 index 5d7bfb1d0c4..00000000000 --- a/src/DrTests/DTPackagesInspectCommand.class.st +++ /dev/null @@ -1,22 +0,0 @@ -" -I inspect the selected package in the package list of DrTests. -" -Class { - #name : 'DTPackagesInspectCommand', - #superclass : 'DTPackagesCommand', - #category : 'DrTests-Commands', - #package : 'DrTests', - #tag : 'Commands' -} - -{ #category : 'default' } -DTPackagesInspectCommand class >> defaultName [ - - ^ 'Inspect' -] - -{ #category : 'executing' } -DTPackagesInspectCommand >> execute [ - - self context inspectSelectedPackage -] diff --git a/src/DrTests/DTPackagesSelectAllCommand.class.st b/src/DrTests/DTPackagesSelectAllCommand.class.st deleted file mode 100644 index de3b19e5f9f..00000000000 --- a/src/DrTests/DTPackagesSelectAllCommand.class.st +++ /dev/null @@ -1,22 +0,0 @@ -" -I select all packages in the package list of DrTests. -" -Class { - #name : 'DTPackagesSelectAllCommand', - #superclass : 'DTPackagesCommand', - #category : 'DrTests-Commands', - #package : 'DrTests', - #tag : 'Commands' -} - -{ #category : 'defaults' } -DTPackagesSelectAllCommand class >> defaultName [ - - ^ 'Select all' -] - -{ #category : 'hooks' } -DTPackagesSelectAllCommand >> execute [ - - self context selectAllInPackageList -] diff --git a/src/DrTests/DTPackagesSelectNoneCommand.class.st b/src/DrTests/DTPackagesSelectNoneCommand.class.st deleted file mode 100644 index 516647afa20..00000000000 --- a/src/DrTests/DTPackagesSelectNoneCommand.class.st +++ /dev/null @@ -1,22 +0,0 @@ -" -I deselect all packages in the package list of DrTests. -" -Class { - #name : 'DTPackagesSelectNoneCommand', - #superclass : 'DTPackagesCommand', - #category : 'DrTests-Commands', - #package : 'DrTests', - #tag : 'Commands' -} - -{ #category : 'defaults' } -DTPackagesSelectNoneCommand class >> defaultName [ - - ^ 'Select none' -] - -{ #category : 'executing' } -DTPackagesSelectNoneCommand >> execute [ - - self context selectNoneInPackageList -] diff --git a/src/DrTests/DTPluginConfiguration.class.st b/src/DrTests/DTPluginConfiguration.class.st deleted file mode 100644 index 4e0ebc6fef2..00000000000 --- a/src/DrTests/DTPluginConfiguration.class.st +++ /dev/null @@ -1,81 +0,0 @@ -" -I hold the information that would be used by a DrTestPlugin. -" -Class { - #name : 'DTPluginConfiguration', - #superclass : 'Object', - #instVars : [ - 'items', - 'packagesSelected', - 'testSuite' - ], - #category : 'DrTests-Model', - #package : 'DrTests', - #tag : 'Model' -} - -{ #category : 'tests' } -DTPluginConfiguration class >> items: aCollectionOfClasses [ - ^ self new - items: aCollectionOfClasses; - yourself -] - -{ #category : 'tests' } -DTPluginConfiguration class >> items: aCollectionOfClasses packages: aCollectionOfPackages [ - ^ self new - items: aCollectionOfClasses; - packagesSelected: aCollectionOfPackages; - yourself -] - -{ #category : 'converting' } -DTPluginConfiguration >> asTestSuite [ - | suite | - suite := TestSuite new. - self items - reject: #isAbstract - thenDo: [ :s | suite addTest: s suite ]. - ^ suite -] - -{ #category : 'result handling' } -DTPluginConfiguration >> handleResults: aPluginResult for: aPlugin [ - ^ aPluginResult -] - -{ #category : 'accessing' } -DTPluginConfiguration >> items [ - ^ items -] - -{ #category : 'accessing' } -DTPluginConfiguration >> items: anObject [ - items := anObject -] - -{ #category : 'accessing' } -DTPluginConfiguration >> items: anObject packages: packages [ - items := anObject. - packagesSelected := packages -] - -{ #category : 'accessing' } -DTPluginConfiguration >> packagesSelected [ - ^ packagesSelected -] - -{ #category : 'accessing' } -DTPluginConfiguration >> packagesSelected: packages [ - packagesSelected := packages -] - -{ #category : 'accessing' } -DTPluginConfiguration >> testSuite [ - ^ testSuite -] - -{ #category : 'accessing' } -DTPluginConfiguration >> testSuite: anObject [ - testSuite := anObject -] diff --git a/src/DrTests/DTPluginResult.class.st b/src/DrTests/DTPluginResult.class.st deleted file mode 100644 index b362f9e1806..00000000000 --- a/src/DrTests/DTPluginResult.class.st +++ /dev/null @@ -1,38 +0,0 @@ -" -I am the abstract superclass for all classes that are results of a plugin in DrTests. -" -Class { - #name : 'DTPluginResult', - #superclass : 'Object', - #category : 'DrTests-Model', - #package : 'DrTests', - #tag : 'Model' -} - -{ #category : 'accessing' } -DTPluginResult >> backgroundColorStyle [ - - ^ 'testResult' -] - -{ #category : 'accessing' } -DTPluginResult >> buildTreeForUI [ - ^ self subclassResponsibility -] - -{ #category : 'accessing' } -DTPluginResult >> summarizeInfo [ - "Text showed in miniDrTests with info of the result " - - ^ self asString -] - -{ #category : 'accessing' } -DTPluginResult >> textColor [ - ^ TestResult defaultColorText -] - -{ #category : 'accessing' } -DTPluginResult >> theme [ - ^ Smalltalk ui theme -] diff --git a/src/DrTests/DTReRunConfiguration.class.st b/src/DrTests/DTReRunConfiguration.class.st deleted file mode 100644 index fa98115a40c..00000000000 --- a/src/DrTests/DTReRunConfiguration.class.st +++ /dev/null @@ -1,50 +0,0 @@ -" -I am a configuration that re-run a part of the result of a previously-run configuration. -" -Class { - #name : 'DTReRunConfiguration', - #superclass : 'DTPluginConfiguration', - #instVars : [ - 'previousResult', - 'configurationToRun', - 'originalConfiguration' - ], - #category : 'DrTests-Model', - #package : 'DrTests', - #tag : 'Model' -} - -{ #category : 'converting' } -DTReRunConfiguration >> asTestSuite [ - ^ self configurationToRun asTestSuite -] - -{ #category : 'accessing' } -DTReRunConfiguration >> configurationToRun [ - ^ configurationToRun -] - -{ #category : 'accessing' } -DTReRunConfiguration >> configurationToRun: anObject [ - configurationToRun := anObject -] - -{ #category : 'accessing' } -DTReRunConfiguration >> originalConfiguration [ - ^ originalConfiguration -] - -{ #category : 'accessing' } -DTReRunConfiguration >> originalConfiguration: anObject [ - originalConfiguration := anObject -] - -{ #category : 'accessing' } -DTReRunConfiguration >> previousResult [ - ^ previousResult -] - -{ #category : 'accessing' } -DTReRunConfiguration >> previousResult: anObject [ - previousResult := anObject -] diff --git a/src/DrTests/DTResultBrowseCommand.class.st b/src/DrTests/DTResultBrowseCommand.class.st deleted file mode 100644 index 378e1a55eb6..00000000000 --- a/src/DrTests/DTResultBrowseCommand.class.st +++ /dev/null @@ -1,26 +0,0 @@ -" -I browse the result selected by user of DrTests. -" -Class { - #name : 'DTResultBrowseCommand', - #superclass : 'DTLeafResultCommand', - #category : 'DrTests-Commands', - #package : 'DrTests', - #tag : 'Commands' -} - -{ #category : 'defaults' } -DTResultBrowseCommand class >> defaultName [ - - ^ 'Browse' -] - -{ #category : 'testing' } -DTResultBrowseCommand >> canBeExecuted [ - ^ self resultSelected canBeBrowsed -] - -{ #category : 'hooks' } -DTResultBrowseCommand >> execute [ - self context browseSelectedResult -] diff --git a/src/DrTests/DTResultCommand.class.st b/src/DrTests/DTResultCommand.class.st deleted file mode 100644 index aaba608eee5..00000000000 --- a/src/DrTests/DTResultCommand.class.st +++ /dev/null @@ -1,21 +0,0 @@ -" -I am an abstract command concerning DrTests' results tree. -" -Class { - #name : 'DTResultCommand', - #superclass : 'DTCommand', - #category : 'DrTests-Commands', - #package : 'DrTests', - #tag : 'Commands' -} - -{ #category : 'testing' } -DTResultCommand class >> isAbstract [ - - ^ self name = #DTResultCommand -] - -{ #category : 'hooks' } -DTResultCommand >> resultSelected [ - ^ self context resultSelected -] diff --git a/src/DrTests/DTResultTreeView.class.st b/src/DrTests/DTResultTreeView.class.st deleted file mode 100644 index d41c6854ab4..00000000000 --- a/src/DrTests/DTResultTreeView.class.st +++ /dev/null @@ -1,49 +0,0 @@ -" -I model a tree view that can be created on a DTPluginResult. -" -Class { - #name : 'DTResultTreeView', - #superclass : 'Object', - #instVars : [ - 'name', - 'blockToExtractViewFromResult' - ], - #category : 'DrTests-Model', - #package : 'DrTests', - #tag : 'Model' -} - -{ #category : 'instance creation' } -DTResultTreeView class >> name: aString blockToExtractViewFromResult: blockToExtractViewFromResult [ - ^ self new - name: aString; - blockToExtractViewFromResult: blockToExtractViewFromResult; - yourself -] - -{ #category : 'accessing' } -DTResultTreeView >> blockToExtractViewFromResult [ - ^ blockToExtractViewFromResult -] - -{ #category : 'accessing' } -DTResultTreeView >> blockToExtractViewFromResult: anObject [ - blockToExtractViewFromResult := anObject -] - -{ #category : 'accessing' } -DTResultTreeView >> name [ - ^ name -] - -{ #category : 'accessing' } -DTResultTreeView >> name: anObject [ - name := anObject -] - -{ #category : 'accessing' } -DTResultTreeView >> resultTreeFor: result [ - result ifNil: [ - ^ DTTreeNode empty ]. - ^ self blockToExtractViewFromResult value: result -] diff --git a/src/DrTests/DTResultsTreeVisitor.class.st b/src/DrTests/DTResultsTreeVisitor.class.st deleted file mode 100644 index 9e8bf4ea2cd..00000000000 --- a/src/DrTests/DTResultsTreeVisitor.class.st +++ /dev/null @@ -1,25 +0,0 @@ -" -I am an abstract visitor for the results tree of DrTests. -" -Class { - #name : 'DTResultsTreeVisitor', - #superclass : 'Object', - #category : 'DrTests-Visitors', - #package : 'DrTests', - #tag : 'Visitors' -} - -{ #category : 'visiting' } -DTResultsTreeVisitor >> visit: anObject [ - ^ anObject acceptVisitor: self -] - -{ #category : 'visiting' } -DTResultsTreeVisitor >> visitDTTreeLeaf: aDTTreeLeaf [ - ^ self subclassResponsibility -] - -{ #category : 'visiting' } -DTResultsTreeVisitor >> visitDTTreeNode: aDTTreeNode [ - ^ aDTTreeNode subResults collect: [ :subResult | self visit: subResult ] -] diff --git a/src/DrTests/DTStatusUpdate.class.st b/src/DrTests/DTStatusUpdate.class.st deleted file mode 100644 index a956f3322d7..00000000000 --- a/src/DrTests/DTStatusUpdate.class.st +++ /dev/null @@ -1,33 +0,0 @@ -" -I am an announcement to force the UI to refresh the status bar. -This is useful when the results are handled in a asynchronous way -" -Class { - #name : 'DTStatusUpdate', - #superclass : 'Announcement', - #instVars : [ - 'message' - ], - #category : 'DrTests-Announcements', - #package : 'DrTests', - #tag : 'Announcements' -} - -{ #category : 'instance creation' } -DTStatusUpdate class >> message: aString [ - - ^ self new - message: aString; - yourself -] - -{ #category : 'accessing' } -DTStatusUpdate >> message [ - - ^ message -] - -{ #category : 'accessing' } -DTStatusUpdate >> message: anObject [ - message := anObject -] diff --git a/src/DrTests/DTStyleContributor.class.st b/src/DrTests/DTStyleContributor.class.st deleted file mode 100644 index 1accbefac92..00000000000 --- a/src/DrTests/DTStyleContributor.class.st +++ /dev/null @@ -1,38 +0,0 @@ -Class { - #name : 'DTStyleContributor', - #superclass : 'StPharoStyleContributor', - #category : 'DrTests-Spec', - #package : 'DrTests', - #tag : 'Spec' -} - -{ #category : 'styles' } -DTStyleContributor >> styleSheetContribution [ - - ^ SpStyle newApplication - addClass: 'testError' with: [ :class | - class addPropertyDrawWith: [ :draw | - draw backgroundColor: TestResult defaultColorBackGroundForErrorTest ] ]; - "addClass: 'testExpectedFailure' with: [ :class | - class addPropertyDrawWith: [ :draw | - draw backgroundColor: Color transparent ] ];" - addClass: 'testFail' with: [ :class | - class addPropertyDrawWith: [ :draw | - draw backgroundColor: TestResult defaultColorBackGroundForFailureTest ] ]; - addClass: 'testPass' with: [ :class | - class addPropertyDrawWith: [ :draw | - draw backgroundColor: TestResult defaultColorBackGroundForPassingTest ] ]; - addClass: 'testSkipped' with: [ :class | - class addPropertyDrawWith: [ :draw | - draw backgroundColor: TestResult defaultColorBackGroundForPassingTest ] ]; - "addClass: 'testUnexpectedPass' with: [ :class | - class addPropertyDrawWith: [ :draw | - draw backgroundColor: Color gray ] ];" - yourself -] - -{ #category : 'styles' } -DTStyleContributor >> theme [ - - ^ Smalltalk ui theme -] diff --git a/src/DrTests/DTTreeLeafNode.class.st b/src/DrTests/DTTreeLeafNode.class.st deleted file mode 100644 index c6b5e9b3089..00000000000 --- a/src/DrTests/DTTreeLeafNode.class.st +++ /dev/null @@ -1,68 +0,0 @@ -" -I am a leaf of a Result Tree. -I have te content and I know the way to browse myself. -" -Class { - #name : 'DTTreeLeafNode', - #superclass : 'DTAbstractTreeNode', - #instVars : [ - 'content' - ], - #category : 'DrTests-Model', - #package : 'DrTests', - #tag : 'Model' -} - -{ #category : 'instance creation' } -DTTreeLeafNode class >> content: aRottenTest [ - ^ self new - content: aRottenTest; - yourself -] - -{ #category : 'visiting' } -DTTreeLeafNode >> acceptVisitor: aDTResultsTreeVisitor [ - ^ aDTResultsTreeVisitor visitDTTreeLeaf: self -] - -{ #category : 'testing' } -DTTreeLeafNode >> canBeBrowsed [ - - ^ true -] - -{ #category : 'accessing' } -DTTreeLeafNode >> content [ - ^ content -] - -{ #category : 'accessing' } -DTTreeLeafNode >> content: anObject [ - content := anObject -] - -{ #category : 'accessing' } -DTTreeLeafNode >> contentForReRun [ - ^ { self content } -] - -{ #category : 'actions' } -DTTreeLeafNode >> drTestsBrowse [ - self content drTestsBrowse -] - -{ #category : 'menu' } -DTTreeLeafNode >> drTestsBuildContextMenu: menu [ - self content drTestsBuildContextMenu: menu -] - -{ #category : 'accessing' } -DTTreeLeafNode >> drTestsName [ - ^ self content drTestsName -] - -{ #category : 'testing' } -DTTreeLeafNode >> isLeaf [ - - ^ true -] diff --git a/src/DrTests/DTTreeNode.class.st b/src/DrTests/DTTreeNode.class.st deleted file mode 100644 index d7561e500eb..00000000000 --- a/src/DrTests/DTTreeNode.class.st +++ /dev/null @@ -1,167 +0,0 @@ -" -I am a node from a tree used to show results in DrTestUI. - -" -Class { - #name : 'DTTreeNode', - #superclass : 'DTAbstractTreeNode', - #instVars : [ - 'name', - 'subResults', - 'contextMenuBlock', - 'subResultsAggregator', - 'browseBlock', - 'shouldStartExpanded', - 'displayColor' - ], - #category : 'DrTests-Model', - #package : 'DrTests', - #tag : 'Model' -} - -{ #category : 'instance creation' } -DTTreeNode class >> empty [ - ^ self new - subResults: #(); - yourself -] - -{ #category : 'visiting' } -DTTreeNode >> acceptVisitor: aDTResultsTreeVisitor [ - ^ aDTResultsTreeVisitor visitDTTreeNode: self -] - -{ #category : 'accessing' } -DTTreeNode >> browseBlock [ - ^ browseBlock -] - -{ #category : 'accessing' } -DTTreeNode >> browseBlock: anObject [ - browseBlock := anObject -] - -{ #category : 'testing' } -DTTreeNode >> canBeBrowsed [ - - ^ self browseBlock isNotNil -] - -{ #category : 'accessing' } -DTTreeNode >> contentForReRun [ - ^ (DTLeavesCollector collectLeavesOf: self) flatCollect: #contentForReRun -] - -{ #category : 'accessing' } -DTTreeNode >> contextMenuBlock [ - ^ contextMenuBlock -] - -{ #category : 'accessing' } -DTTreeNode >> contextMenuBlock: anObject [ - contextMenuBlock := anObject -] - -{ #category : 'accessing' } -DTTreeNode >> displayColor [ - - ^ displayColor value -] - -{ #category : 'accessing' } -DTTreeNode >> displayColor: aValuableOrColor [ - - displayColor := aValuableOrColor -] - -{ #category : 'accessing' } -DTTreeNode >> displayColorIfNotEmpty: aColor [ - - self displayColor: [ - self subResults - ifNotEmpty: [ aColor ] - ifEmpty: [ nil ] ] -] - -{ #category : 'actions' } -DTTreeNode >> drTestsBrowse [ - "Browse the tree node according to what is specified by my #browseBlock. - If my #browseBlock is nil, does nothing." - self canBeBrowsed - ifFalse: [ ^ self ]. - - self browseBlock cull: self -] - -{ #category : 'menu' } -DTTreeNode >> drTestsBuildContextMenu: menu [ - self contextMenuBlock value: menu -] - -{ #category : 'accessing' } -DTTreeNode >> drTestsName [ - - ^ String streamContents: [ :s | - s - << self name; - << ' ('; - << (self subResultsAggregator value: self subResults) asString; - << ')' ] -] - -{ #category : 'initialization' } -DTTreeNode >> initialize [ - - super initialize. - self contextMenuBlock: [ :menu | ]. "Does nothing by default." - self subResultsAggregator: [ :subRes | (DTLeavesCollector collectLeavesOf: self) size ]. - shouldStartExpanded := false -] - -{ #category : 'accessing' } -DTTreeNode >> name [ - ^ name -] - -{ #category : 'accessing' } -DTTreeNode >> name: anObject [ - name := anObject -] - -{ #category : 'testing' } -DTTreeNode >> shouldStartExpanded [ - - ^ shouldStartExpanded -] - -{ #category : 'accessing' } -DTTreeNode >> startContracted [ - - shouldStartExpanded := false -] - -{ #category : 'accessing' } -DTTreeNode >> startExpanded [ - - shouldStartExpanded := true -] - -{ #category : 'accessing' } -DTTreeNode >> subResults [ - ^ subResults -] - -{ #category : 'accessing' } -DTTreeNode >> subResults: anObject [ - subResults := anObject -] - -{ #category : 'accessing' } -DTTreeNode >> subResultsAggregator [ - ^ subResultsAggregator -] - -{ #category : 'accessing' } -DTTreeNode >> subResultsAggregator: anObject [ - subResultsAggregator := anObject -] diff --git a/src/DrTests/DTUpdateResults.class.st b/src/DrTests/DTUpdateResults.class.st deleted file mode 100644 index 7185d9ee40f..00000000000 --- a/src/DrTests/DTUpdateResults.class.st +++ /dev/null @@ -1,26 +0,0 @@ -" -I am an announcement to force the UI to refresh the results. -This is useful when the results are handled in a asynchronous way -" -Class { - #name : 'DTUpdateResults', - #superclass : 'Announcement', - #instVars : [ - 'results' - ], - #category : 'DrTests-Announcements', - #package : 'DrTests', - #tag : 'Announcements' -} - -{ #category : 'accessing' } -DTUpdateResults >> results [ - - ^ results -] - -{ #category : 'accessing' } -DTUpdateResults >> results: anObject [ - - results := anObject -] diff --git a/src/DrTests/DrTests.class.st b/src/DrTests/DrTests.class.st deleted file mode 100644 index a13213aa7c1..00000000000 --- a/src/DrTests/DrTests.class.st +++ /dev/null @@ -1,321 +0,0 @@ -" -I provide the ability to: -* select a plugin to create/run tests -* select sets of items to analyze -* obtain a detailed log of the results - -UI Description -___________ - -The droplist contains all the plugins available to start the analysis. - -My left-most pane lists all of the categories that contain items (could subclasses of TestCase, executable comments, etc.); Once items are selected, the items that can be analyzed appear in the pane to right. -The right-most pane shows the results in different groups, depends the plugin's analysis. - -Run and browse buttons behaviour are defined by the current plugin selected. - - -" -Class { - #name : 'DrTests', - #superclass : 'AbstractDrTestsPresenter', - #instVars : [ - 'pluginsDropList', - 'statusLabel', - 'plugins', - 'pluginPresenter' - ], - #category : 'DrTests-Spec', - #package : 'DrTests', - #tag : 'Spec' -} - -{ #category : 'tools registry' } -DrTests class >> beDefaultTestRunner [ -