[BUG][FIX] SystemNavigation broken

Andreas Raab andreas.raab at gmx.de
Sat May 28 19:42:25 UTC 2005

"Change Set:		SysNavFix-ar
Date:			28 May 2005
Author:			Andreas Raab

Fix a few uses of #isMemberOf: Symbol."!
-------------- next part --------------
'From Squeak3.8gamma of ''24 November 2004'' [latest update: #6662] on 28 May 2005 at 12:41:14 pm'!
"Change Set:		SysNavFix-ar
Date:			28 May 2005
Author:			Andreas Raab

Fix a few uses of #isMemberOf: Symbol."!

!SystemNavigation methodsFor: 'query' stamp: 'ar 5/28/2005 12:32'!
allCallsOn: aLiteral 
	"Answer a Collection of all the methods that call on aLiteral even deeply embedded in 
	literal array."
	"self new browseAllCallsOn: #open:label:."
	| aCollection special thorough aList byte |
	aCollection _ OrderedCollection new.
	special _ Smalltalk
				hasSpecialSelector: aLiteral
				ifTrueSetByte: [:b | byte _ b].
	thorough _ (aLiteral isSymbol)
				and: ["Possibly search for symbols imbedded in literal arrays"
					Preferences thoroughSenders].
	Cursor wait
		showWhile: [self
				allBehaviorsDo: [:class | 
					aList _ thorough
								ifTrue: [class
										thoroughWhichSelectorsReferTo: aLiteral
										special: special
										byte: byte]
								ifFalse: [class
										whichSelectorsReferTo: aLiteral
										special: special
										byte: byte].
						do: [:sel | sel == #DoIt
								ifFalse: [aCollection
										add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]].
	^ aCollection! !

!SystemNavigation methodsFor: 'query' stamp: 'ar 5/28/2005 12:33'!
allSentMessagesWithout: classesAndMessagesPair 
	"Answer the set of selectors which are sent somewhere in the system,  
	computed in the absence of the supplied classes and messages."
	| sent absentClasses absentSelectors |
	sent _ IdentitySet new: CompiledMethod instanceCount.
	absentClasses _ classesAndMessagesPair first.
	absentSelectors _ classesAndMessagesPair second.
	self flag: #shouldBeRewrittenUsingSmalltalkAllClassesDo:.
	"sd 29/04/03"
	Cursor execute
		showWhile: [Smalltalk classNames
				do: [:cName | ((absentClasses includes: cName)
						ifTrue: [{}]
						ifFalse: [{Smalltalk at: cName. (Smalltalk at: cName) class}])
						do: [:cl | (absentSelectors isEmpty
								ifTrue: [cl selectors]
								ifFalse: [cl selectors copyWithoutAll: absentSelectors])
								do: [:sel | "Include all sels, but not if sent by self"
									(cl compiledMethodAt: sel) literals
										do: [:m | 
											(m isSymbol)
												ifTrue: ["might be sent"
													m == sel
														ifFalse: [sent add: m]].
											(m isMemberOf: Array)
												ifTrue: ["might be performed"
														do: [:x | (x isSymbol)
																ifTrue: [x == sel
																		ifFalse: [sent add: x]]]]]]]].
			"The following may be sent without being in any literal frame"
				to: Smalltalk specialSelectorSize
				do: [:index | sent
						add: (Smalltalk specialSelectorAt: index)]].
	Smalltalk presumedSentMessages
		do: [:sel | sent add: sel].
	^ sent! !

More information about the Squeak-dev mailing list