!SystemTracer methodsFor: 'initialization'! initDict writeDict _ Dictionary new: 256. Smalltalk allClassesDo: [:class | class isBits ifTrue: [writeDict at: class put: (class isBytes ifTrue: [#writeBytes:] ifFalse: [#writeWords:])] ifFalse: [writeDict at: class put: #writePointers:. (class inheritsFrom: Set) | (class == Set) ifTrue: [writeDict at: class put: #writeSet:]. (class inheritsFrom: IdentitySet) | (class == IdentitySet) ifTrue: [writeDict at: class put: #writeIdentitySet:]. (class inheritsFrom: IdentityDictionary) | (class == IdentityDictionary) ifTrue: [writeDict at: class put: #writeIdentitySet:]. (class inheritsFrom: MethodDictionary) | (class == MethodDictionary) ifTrue: [writeDict at: class put: #writeMethodDictionary:]]. ]. "check for Associations of replaced classes" writeDict at: Association put: #writeAssociation:. self systemNavigation allBehaviorsDo: [:class | writeDict at: class class put: #writeBehavior:]. writeDict at: PseudoContext class put: #writeBehavior:. writeDict at: SmallInteger put: #writeClamped:. writeDict at: CompiledMethod put: #writeMethod:. writeDict at: Process put: #writeProcess:. writeDict at: MethodContext put: #writeContext:. writeDict at: BlockContext put: #writeContext:.! ! !TestViaMethodCall class methodsFor: 'system navigation'! systemNavigation ^ SystemNavigation new! ! !TestViaMethodCall class methodsFor: 'as yet unclassified'! buildSuiteFromLocalSelectors "Return a list of tests to perform" | ts | ts _ TestSuite new name: 'From Many Classes'. (self systemNavigation allImplementorsOf: #exampleFor:) do: [:mr | mr classIsMeta ifTrue: [((Smalltalk at: mr classSymbol) exampleFor: 'all') do: [:aVerifier | ts addTest: (self new verifier: aVerifier)]]]. ^ ts! addClassesTo: aList "Add names of classes that have tests to perform" (self systemNavigation allImplementorsOf: #exampleFor:) do: [:mr | mr classIsMeta ifTrue: [aList add: mr classSymbol , ' (simple)']]. ^ aList! !