Use `allTestSelectors includes:` instead of `isTestSelector:` jv
authorJan Vrany <jan.vrany@labware.com>
Wed, 07 Sep 2022 15:27:34 +0100
branchjv
changeset 19640 9001c87bacbe
parent 19638 f0275261f2ca
child 19641 536881930470
Use `allTestSelectors includes:` instead of `isTestSelector:` ...as the latter is Smalltalk/X specific so overriding it won't work with portable code. Indeed, this is much slower for large classes. Will see.
Tools__MethodCategoryList.st
Tools__MethodList.st
Tools__NewSystemBrowser.st
Tools__TestRunnerMini.st
--- a/Tools__MethodCategoryList.st	Wed Oct 05 11:34:56 2022 +0100
+++ b/Tools__MethodCategoryList.st	Wed Sep 07 15:27:34 2022 +0100
@@ -1,6 +1,7 @@
 "
  COPYRIGHT (c) 2000 by eXept Software AG
  COPYRIGHT (c) 2016 Jan Vrany
+ COPYRIGHT (c) 2022 LabWare
               All Rights Reserved
 
  This software is furnished under a license and may be used
@@ -56,6 +57,7 @@
 "
  COPYRIGHT (c) 2000 by eXept Software AG
  COPYRIGHT (c) 2016 Jan Vrany
+ COPYRIGHT (c) 2022 LabWare
               All Rights Reserved
 
  This software is furnished under a license and may be used
@@ -1009,7 +1011,7 @@
                                             
                                         includeIt ifFalse:[
                                             (allTestsNotPassedProtocols and:[isTestCaseClass]) ifTrue:[
-                                                (aClass isTestSelector:sel) ifTrue:[
+                                                (aClass allTestSelectors includes:sel) ifTrue:[
                                                     |lastResultOrNil|
 
                                                     lastResultOrNil := aClass asTestCase rememberedOutcomeFor:sel.
@@ -1143,6 +1145,7 @@
     "Created: / 05-02-2000 / 13:42:10 / cg"
     "Modified: / 18-09-2011 / 12:51:45 / cg"
     "Modified: / 26-07-2016 / 23:31:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 07-09-2022 / 15:08:32 / Jan Vrany <jan.vrany@labware.com>"
 ! !
 
 !MethodCategoryList methodsFor:'private'!
@@ -1500,7 +1503,7 @@
                 itemsInRemoteChangeSet add:mCategory.    
             ].
             isTestCaseClass ifTrue:[
-                (eachClass isTestSelector:mSelector) ifTrue:[
+                (eachClass allTestSelectors includes:mSelector) ifTrue:[
                     |lastResultOrNil|
                     
                     lastResultOrNil := eachClass asTestCase rememberedOutcomeFor:mSelector.
@@ -1694,6 +1697,7 @@
     "Created: / 05-02-2000 / 13:42:11 / cg"
     "Modified: / 08-09-2011 / 04:56:47 / cg"
     "Modified: / 26-07-2016 / 23:31:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 07-09-2022 / 15:08:53 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 makeDependent
--- a/Tools__MethodList.st	Wed Oct 05 11:34:56 2022 +0100
+++ b/Tools__MethodList.st	Wed Sep 07 15:27:34 2022 +0100
@@ -1,6 +1,7 @@
 "
  COPYRIGHT (c) 2000 by eXept Software AG
  COPYRIGHT (c) 2016-2017 Jan Vrany
+ COPYRIGHT (c) 2022 LabWare
 	      All Rights Reserved
 
  This software is furnished under a license and may be used
@@ -34,6 +35,7 @@
 "
  COPYRIGHT (c) 2000 by eXept Software AG
  COPYRIGHT (c) 2016-2017 Jan Vrany
+ COPYRIGHT (c) 2022 LabWare
 	      All Rights Reserved
 
  This software is furnished under a license and may be used
@@ -1772,7 +1774,7 @@
         "/ (selector isSymbol and:[selector startsWith:'test']) ifTrue:[
         (((cls isTestCaseLike) and:[cls isAbstract not])
         or:[self showSyntheticMethods value and:[aMethod isSynthetic]]) ifTrue:[
-            (cls isTestCaseLike and:[cls isTestSelector:selector]) ifTrue:[
+            (cls isTestCaseLike and:[cls allTestSelectors includes:selector]) ifTrue:[
                 "JV@2011-11-17: Show thumbs even if not all test were run"
 
                 lastResultOrNil := cls asTestCase rememberedOutcomeFor:selector.
@@ -1896,6 +1898,7 @@
     "Modified: / 15-08-2009 / 13:13:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
     "Modified: / 07-03-2012 / 19:06:09 / cg"
     "Modified: / 27-07-2016 / 00:05:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 07-09-2022 / 15:06:17 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 resourceIconForMethod:aMethod
--- a/Tools__NewSystemBrowser.st	Wed Oct 05 11:34:56 2022 +0100
+++ b/Tools__NewSystemBrowser.st	Wed Sep 07 15:27:34 2022 +0100
@@ -40458,7 +40458,7 @@
                                     self
                                         selectedProtocolMethodsDo:[:cls :category :sel :mthd |
                                             (cls isTestCaseLike and:[ cls isAbstract not ]) ifTrue:[
-                                                (cls isTestSelector:sel) ifTrue:[
+                                                (cls allTestSelectors includes:sel) ifTrue:[
                                                     selectors add:sel
                                                 ].
                                             ].
@@ -40499,6 +40499,7 @@
     "Modified: / 06-07-2011 / 14:07:52 / cg"
     "Modified: / 21-08-2011 / 13:54:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 26-12-2013 / 22:01:37 / f.urbach"
+    "Modified: / 07-09-2022 / 15:06:03 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 selectedNonAbstractTestCaseClassesDo:aBlock
--- a/Tools__TestRunnerMini.st	Wed Oct 05 11:34:56 2022 +0100
+++ b/Tools__TestRunnerMini.st	Wed Sep 07 15:27:34 2022 +0100
@@ -2,7 +2,7 @@
  Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
  Copyright (c) 2009-2010 eXept Software AG
  Copyright (c) 2016-2017 Jan Vrany
- Copyright (c) 2021 LabWare
+ Copyright (c) 2021-2022 LabWare
 
  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
@@ -54,7 +54,7 @@
  Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
  Copyright (c) 2009-2010 eXept Software AG
  Copyright (c) 2016-2017 Jan Vrany
- Copyright (c) 2021 LabWare
+ Copyright (c) 2021-2022 LabWare
 
  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
@@ -422,11 +422,12 @@
             [:mthd | | cls |
             (cls := selectedClass) isNil ifTrue:[cls := mthd mclass].
             (self isTestCaseLike:selectedClass) 
-                and:[ selectedClass isTestSelector:mthd selector ] ]
+                and:[ selectedClass allTestSelectors includes:mthd selector ] ]
 
     "Created: / 15-03-2010 / 13:21:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 22-07-2011 / 15:46:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 02-08-2011 / 17:46:38 / cg"
+    "Modified: / 07-09-2022 / 15:02:30 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 selectedTestMethodsFromProtocols:protocols 
@@ -437,17 +438,17 @@
     generator := self methodGeneratorHolder value.
     selectedClass := self theSingleTestCase.
 
-    generator notNil ifTrue:[ 
+    generator notNil ifTrue:[
         generator do: [:cls :cat :sel :mthd | 
             (mthd notNil 
                 and:[ (self isTestCaseLike:(selectedClass ? cls)) 
-                and:[ (selectedClass ? cls) isTestSelector:sel ] ]) 
+                and:[ (selectedClass ? cls) allTestSelectors includes:sel ] ]) 
             ifTrue:[ methods add:mthd ] 
         ] 
     ] ifFalse:[
         allTestCases do: [:cls | 
             cls methodsDo: [:mthd | 
-                ((protocols includes:mthd category) and:[ cls isTestSelector:mthd selector ]) 
+                ((protocols includes:mthd category) and:[ cls allTestSelectors includes: mthd selector ]) 
                 ifTrue:[ 
                     methods add:mthd 
                 ] 
@@ -459,6 +460,7 @@
     "Created: / 15-03-2010 / 19:50:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 22-07-2011 / 15:53:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified (format): / 04-06-2012 / 19:05:32 / cg"
+    "Modified: / 07-09-2022 / 15:04:59 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 selectedTestMethodsFromProtocols:protocols inClass:aTestClass
@@ -472,13 +474,13 @@
         generator do: [:cls :cat :sel :mthd | 
             (mthd notNil 
                 and:[ (self isTestCaseLike:(aTestClass ? cls)) 
-                and:[ (aTestClass ? cls) isTestSelector:sel ] ]) 
+                and:[ (aTestClass ? cls) allTestSelectors includes: sel ] ]) 
             ifTrue:[ methods add:mthd ] 
         ] 
     ] ifFalse:[
         self allTestCases do: [:cls | 
             cls methodsDo: [:mthd | 
-                ((protocols includes:mthd category) and:[ cls isTestSelector:mthd selector ]) 
+                ((protocols includes:mthd category) and:[ cls allTestSelectors includes:mthd selector ]) 
                 ifTrue:[ 
                     methods add:mthd 
                 ] 
@@ -487,11 +489,12 @@
     ].
     methods := methods asOrderedCollection.
     methods sortBySelector:#selector.
-    ^ methods 
+    ^ methods
 
     "Created: / 15-03-2010 / 19:50:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 22-07-2011 / 15:53:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified (format): / 04-06-2012 / 19:05:32 / cg"
+    "Modified: / 07-09-2022 / 15:05:32 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 selectedTestMethodsInClass:testClass
@@ -499,11 +502,12 @@
             [:mthd | | cls |
             (cls := testClass) isNil ifTrue:[cls := mthd mclass].
             (self isTestCaseLike:testClass) 
-                and:[ testClass isTestSelector:mthd selector ] ]
+                and:[ testClass allTestSelectors includes:mthd selector ] ]
 
     "Created: / 15-03-2010 / 13:21:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 22-07-2011 / 15:46:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 02-08-2011 / 17:46:38 / cg"
+    "Modified: / 07-09-2022 / 15:05:49 / Jan Vrany <jan.vrany@labware.com>"
 !
 
 theSingleTestCase