--- a/Tools__TestRunnerMini.st Tue Jul 02 21:56:45 2019 +0200
+++ b/Tools__TestRunnerMini.st Sun Jul 07 15:00:50 2019 +0200
@@ -759,20 +759,58 @@
tests. Requires that the testcase returns a non-empty collection
from the coveredClasses query"
- |testedClasses suite instrumentPackage|
+ |testedClasses suite instrumentPackage suiteClasses suiteClass
+ answer coveredClassNamesString coveredClassNames coveredClasses|
suite := self suiteForRunAll.
instrumentPackage := false.
- testedClasses := self allCoveredClasses.
+ testedClasses := suite allCoveredClasses.
testedClasses isEmpty ifTrue:[
- self suiteForRunAll tests isEmpty ifTrue:[
+ suite tests isEmpty ifTrue:[
Dialog warn:(resources stringWithCRs:'The test suite is empty - nothing covered, I assume.').
^ self.
- ].
- (Dialog confirm:(resources stringWithCRs:'The test cases do not define any covered class.\(missing #coveredClassNames or #coveredPackageNames method on the TestCase''s class side)\\Run without coverage ?'))
- ifFalse:[^ self].
- ] ifFalse:[
+ ].
+ suiteClasses := suite tests collect:#class.
+ suiteClasses size == 1 ifTrue:[
+ suiteClass := suiteClasses first
+ ].
+ suiteClass notNil ifTrue:[
+ answer := Dialog
+ confirmWithCancel:(resources stringWithCRs:'The test cases do not define any covered class.\(missing #coveredClassNames or #coveredPackageNames method on the TestCase''s class side)\\Define covered classes now?\(click on "No" to run without coverage)')
+ labels:(resources array:#('Cancel' 'No' 'Yes')).
+ answer isNil ifTrue:[^ self].
+
+ answer == true ifTrue:[
+ coveredClassNamesString := Dialog request:'Name(s) of class(es) covered by test\(separate by blanks)'.
+ coveredClassNamesString isEmptyOrNil ifTrue:[^ self].
+ coveredClassNames := (coveredClassNamesString splitBy:' ') collect:#withoutSeparators.
+ coveredClasses := coveredClassNames
+ collect:[:nm |
+ |cls|
+
+ (cls := Smalltalk classNamed:nm) isNil ifTrue:[
+ Dialog warn:'No class named "%1" found' with:nm
+ ].
+ cls]
+ thenSelect:[:cls | cls notNil].
+
+ (suiteClass theMetaclass includesSelector:#coveredClassNames) ifFalse:[
+ suiteClass theMetaclass
+ compile:('coveredClassNames
+ "These classes will be instrumented for coverage analysis,
+ before running the suite to provide coverage analysis/report"
+
+ ^ %1
+' bindWith:(coveredClasses collect:#name as:Array) storeString)
+ classified:'queries'.
+ testedClasses := suite allCoveredClasses.
+ ].
+ ].
+ ].
+ ].
+
+ testedClasses notEmptyOrNil ifTrue:[
self withWaitCursorDo:[
infoHolder notNil ifTrue:[
infoHolder value:('Instrumenting...')
@@ -1185,15 +1223,7 @@
tests. Requires that the testcase returns a non-empty collection
from the coveredClasses query"
- |testedClasses suite|
-
- testedClasses := Set new.
-
- suite := self suiteForRunAll.
- suite tests do:[:eachTest |
- testedClasses addAll:(eachTest class coveredClasses).
- ].
- ^ testedClasses
+ ^ self suiteForRunAll allCoveredClasses.
!
hasTestCaseSelected