Tools__MethodCategoryList.st
changeset 19256 fdb9c39f8ceb
parent 19089 ab957ca7680d
child 19257 0f7a0fce2cd4
--- a/Tools__MethodCategoryList.st	Sat Nov 02 13:08:20 2019 +0100
+++ b/Tools__MethodCategoryList.st	Sun Nov 03 11:19:20 2019 +0100
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
 "
  COPYRIGHT (c) 2000 by eXept Software AG
               All Rights Reserved
@@ -899,9 +897,9 @@
 !MethodCategoryList methodsFor:'generators'!
 
 makeGenerator
-    "return a generator which enumerates the methods from the selected protocol;
+    "return a generator which enumerates the methods from the selected protocol(s);
      that generator generates 4-element elements (includes the class and protocol), 
-     in order to make the consumers only depend on one input 
+     in order to make the consumers only depend on one input. 
      (i.e. to pass multiple-class and multiple-protocol info
       without a need for another classHolder/protocolHolder in the methodList)."
 
@@ -933,29 +931,43 @@
             leafClasses remove:nil ifAbsent:[]. "/ may happen when hierarchies are changed elsewhere.
             
             (leafClasses size ~~ 0 and:[protocols size ~~ 0]) ifTrue:[
-                allProtocols := protocols includes:(self class nameListEntryForALL).
-                superSendProtocols := protocols includes:(self class nameListEntryForSuperSend).
-                uncommentedProtocols := protocols includes:(self class nameListEntryForUncommented).
-                obsoleteProtocols := protocols includes:(self class nameListEntryForObsolete).
-                documentationProtocols := protocols includes:(self class nameListEntryForDocumentation).
-                longProtocols := protocols includes:(self class nameListEntryForLong).
-                extensionProtocols := protocols includes:(self class nameListEntryForExtensions).
-                redefinedProtocols := protocols includes:(self class nameListEntryForRedefined).
-                redefineProtocols := protocols includes:(self class nameListEntryForRedefine).
-                overrideProtocols := protocols includes:(self class nameListEntryForOverride).
-                missingRequiredProtocols := protocols includes:(self class nameListEntryForRequired).
-                subclassResponsibilities := protocols includes:(self class nameListEntryForMustBeRedefinedInSubclass).
-                annotatedProtocols := protocols includes:(self class nameListEntryForAnnotated).
+                "/ any special pseudo protocol wanted?
+                allProtocols := superSendProtocols := uncommentedProtocols := false.
+                obsoleteProtocols := documentationProtocols := longProtocols := false.
+                extensionProtocols := redefinedProtocols := redefineProtocols := false.
+                overrideProtocols := missingRequiredProtocols := subclassResponsibilities := false.
+                annotatedProtocols := false.
+                fullyCoveredProtocols := partiallyCoveredProtocols := uncoveredProtocols := false.
+                notInstrumentedProtocols := anyCoverage := allTestsProtocols := false.
+                allTestsNotPassedProtocols := false.
 
-                fullyCoveredProtocols := protocols includes:(self class nameListEntryForFullyCovered).
-                partiallyCoveredProtocols := protocols includes:(self class nameListEntryForPartiallyCovered).
-                uncoveredProtocols := protocols includes:(self class nameListEntryForUncovered).
-                notInstrumentedProtocols := protocols includes:(self class nameListEntryForNotInstrumented).
-                anyCoverage := fullyCoveredProtocols | partiallyCoveredProtocols 
-                               | uncoveredProtocols | notInstrumentedProtocols.
+                (protocols contains:[:p | p startsWith:'*']) ifTrue:[
+                    allProtocols := protocols includes:(self class nameListEntryForALL).
+                    allProtocols ifFalse:[
+                        superSendProtocols := protocols includes:(self class nameListEntryForSuperSend).
+                        uncommentedProtocols := protocols includes:(self class nameListEntryForUncommented).
+                        obsoleteProtocols := protocols includes:(self class nameListEntryForObsolete).
+                        documentationProtocols := protocols includes:(self class nameListEntryForDocumentation).
+                        longProtocols := protocols includes:(self class nameListEntryForLong).
+                        extensionProtocols := protocols includes:(self class nameListEntryForExtensions).
+                        redefinedProtocols := protocols includes:(self class nameListEntryForRedefined).
+                        redefineProtocols := protocols includes:(self class nameListEntryForRedefine).
+                        overrideProtocols := protocols includes:(self class nameListEntryForOverride).
+                        missingRequiredProtocols := protocols includes:(self class nameListEntryForRequired).
+                        subclassResponsibilities := protocols includes:(self class nameListEntryForMustBeRedefinedInSubclass).
+                        annotatedProtocols := protocols includes:(self class nameListEntryForAnnotated).
 
-                allTestsProtocols := protocols includes:(self class nameListEntryForAllTests).
-                allTestsNotPassedProtocols := protocols includes:(self class nameListEntryForTestsNotPassed).
+                        fullyCoveredProtocols := protocols includes:(self class nameListEntryForFullyCovered).
+                        partiallyCoveredProtocols := protocols includes:(self class nameListEntryForPartiallyCovered).
+                        uncoveredProtocols := protocols includes:(self class nameListEntryForUncovered).
+                        notInstrumentedProtocols := protocols includes:(self class nameListEntryForNotInstrumented).
+                        anyCoverage := fullyCoveredProtocols | partiallyCoveredProtocols 
+                                        | uncoveredProtocols | notInstrumentedProtocols.
+
+                        allTestsProtocols := protocols includes:(self class nameListEntryForAllTests).
+                        allTestsNotPassedProtocols := protocols includes:(self class nameListEntryForTestsNotPassed).
+                    ].
+                ].
 
                 packages := packageFilter value value.
                 (packages notNil and:[packages includes:(self class nameListEntryForALL)]) ifTrue:[