'From Squeak3.4 of 1 March 2003 [latest update: #5170] on 4 April 2003 at 3:42:30 pm'! TestCase subclass: #CleanKernelTest instanceVariableNames: 'classesCreated ' classVariableNames: '' poolDictionaries: '' category: 'KCP'! !CleanKernelTest methodsFor: 'behavior'! testAccessingClassHierarchy "self run: #testAccessingClassHierarchy" | clsRoot clsA clsB clsC1 clsC2 | clsRoot _ self createClassNamed: #Root. clsA _ self createClassNamed: #A superClass: clsRoot. clsB _ self createClassNamed: #B superClass: clsA. clsC1 _ self createClassNamed: #C1 superClass: clsB. clsC2 _ self createClassNamed: #C2 superClass: clsB. "--------" self assert: clsRoot subclasses size = 1. self assert: (clsRoot subclasses includes: clsA). self assert: clsB subclasses size = 2. self assert: (clsB subclasses includesAllOf: (Array with: clsC1 with: clsC2)). self assert: clsC1 subclasses isEmpty. "--------" self assert: clsRoot allSubclasses size = 4. self assert: (clsRoot allSubclasses includesAllOf: (Array with: clsA with: clsB with: clsC1 with: clsC2)). "--------" self assert: clsRoot withAllSubclasses size = 5. self assert: (clsRoot withAllSubclasses includesAllOf: (Array with: clsA with: clsB with: clsC1 with: clsC2 with: clsRoot)). ! ! !CleanKernelTest methodsFor: 'behavior'! testAccessingClassHierarchySuperclasses "self run: #testAccessingClassHierarchySuperclasses" | clsRoot clsA clsB clsC1 clsC2 | clsRoot _ self createClassNamed: #Root. clsA _ self createClassNamed: #A superClass: clsRoot. clsB _ self createClassNamed: #B superClass: clsA. clsC1 _ self createClassNamed: #C1 superClass: clsB. clsC2 _ self createClassNamed: #C2 superClass: clsB. "--------" self assert: clsC2 superclass == clsB. self assert: (clsC2 allSuperclasses includes: clsA). self assert: clsC2 allSuperclasses size = 5. self assert: (clsC2 allSuperclasses includesAllOf: (Array with: clsB with: clsA with: clsRoot with: Object with: ProtoObject)). "--------" self assert: clsC1 superclass == clsB. self assert: (clsC1 allSuperclasses includes: clsA). self assert: clsC1 allSuperclasses size = 5. self assert: (clsC1 allSuperclasses includesAllOf: (Array with: clsB with: clsA with: clsRoot with: Object with: ProtoObject)). "--------" self assert: clsC2 withAllSuperclasses size = (clsC2 allSuperclasses size + 1). self assert: (clsC2 withAllSuperclasses includesAllOf: clsC2 allSuperclasses). self assert: (clsC2 withAllSuperclasses includes: clsC2). "--------" self assert: clsC1 withAllSuperclasses size = (clsC1 allSuperclasses size + 1). self assert: (clsC1 withAllSuperclasses includesAllOf: clsC1 allSuperclasses). self assert: (clsC1 withAllSuperclasses includes: clsC1)! ! !CleanKernelTest methodsFor: 'utility'! classesCreated classesCreated ifNil: [ classesCreated := OrderedCollection new]. ^ classesCreated! ! !CleanKernelTest methodsFor: 'utility'! createClassNamed: aClassname ^ self createClassNamed: aClassname superClass: Object! ! !CleanKernelTest methodsFor: 'utility'! createClassNamed: aClassname superClass: aClass | r | r := aClass subclass: aClassname instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'KCP-Tests'. self classesCreated add: r. ^ r! ! !CleanKernelTest reorganize! ('behavior' testAccessingClassHierarchy testAccessingClassHierarchySuperclasses) ('utility' classesCreated createClassNamed: createClassNamed:superClass: isSelector:definedInClass: isSelector:deprecatedInClass: removeClassNamedIfExists:) ('module reference' testRemoveSubclassModuleMethod testRemoveSubclassModuleMethodInClass) ('isMeta' testBehaviorDefineIsMeta testMetaclassDefineIsMeta testPullUpIsMeta) ('allSubclasses' testPullUpAllSubclasses) ('environment' testMetaclassClassClassDescriptionDoesNotReferToSmalltalk testMetaclassDoesNotReferToSmalltalk testNilEnvironment) ('browing' testRemoveAllCallsOn testRemoveBroweMethod testRemoveBrowseAllAccesses testRemoveBrowseAllCallsOn testRemoveBrowseAllStores testRemoveBrowseClassVarRef testRemoveBrowseClassVariables testRemoveBrowseInstVarDefs testRemoveBrowseInstVarRefs) ('teardown' tearDown) !