Fix/1186: Move DrTests to newTools

src/BaselineOfDrTests/BaselineOfDrTests.class.st

@@ -0,0 +1,45 @@
+Class {
+	#name : 'BaselineOfDrTests',
+	#superclass : 'BaselineOf',
+	#category : 'BaselineOfDrTests',
+	#package : 'BaselineOfDrTests'
+}
+
+{ #category : 'baselines' }
+BaselineOfDrTests >> baseline: spec [
+	<baseline>
+	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').
+
+]

src/BaselineOfDrTests/package.st

@@ -0,0 +1 @@
+Package { #name : 'BaselineOfDrTests' }

src/DrTests-CommentsToTests-Tests/CommentsToTestsTest.class.st

@@ -0,0 +1,61 @@
+"
+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
+]

src/DrTests-CommentsToTests-Tests/package.st

@@ -0,0 +1 @@
+Package { #name : 'DrTests-CommentsToTests-Tests' }

src/DrTests-CommentsToTests/DTCommentTestConfiguration.class.st

@@ -0,0 +1,25 @@
+"
+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
+]

src/DrTests-CommentsToTests/DTCommentToTestPlugin.class.st

@@ -0,0 +1,108 @@
+"
+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
+]

src/DrTests-CommentsToTests/DTCommentToTestResult.class.st

@@ -0,0 +1,55 @@
+"
+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 [
+	<dtCommentToTestResultTreeNamed: 'Grouped by type of result' order: 1>
+
+	^ 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
+]

src/DrTests-CommentsToTests/package.st

@@ -0,0 +1 @@
+Package { #name : 'DrTests-CommentsToTests' }

src/DrTests-RottenGreenTestsFinder/DTRFTPlugin.class.st

@@ -0,0 +1,80 @@
+"
+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
+]

src/DrTests-RottenGreenTestsFinder/DTRTFConfiguration.class.st

@@ -0,0 +1,10 @@
+"
+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'
+}