[Pkg] The Trunk: System-ul.449.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Jul 18 18:17:44 UTC 2011
Levente Uzonyi uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-ul.449.mcz
==================== Summary ====================
Name: System-ul.449
Author: ul
Time: 18 July 2011, 2:01:28.809 am
UUID: baaab250-ffd3-814b-9e6f-7ef5ab04f991
Ancestors: System-ul.448
SystemNavigation refactoring part 2.
=============== Diff against System-ul.448 ===============
Item was changed:
+ ----- Method: Behavior>>allCallsOn (in category '*System-Support') -----
- ----- Method: Behavior>>allCallsOn (in category '*system-support') -----
allCallsOn
"Answer a SortedCollection of all the methods that refer to me by name or as part of an association in a global dict."
+ ^self systemNavigation allCallsOn: self theNonMetaClass name!
- ^self systemNavigation allCallsOn: self theNonMetaClass name!
Item was changed:
+ ----- Method: Behavior>>allCallsOn: (in category '*System-Support') -----
- ----- Method: Behavior>>allCallsOn: (in category '*system-support') -----
allCallsOn: aSymbol
+ "Answer a sorted collection of all the methods that call on aSymbol."
- "Answer a SortedCollection of all the methods that call on aSymbol."
+ ^self systemNavigation allCallsOn: aSymbol from: self.
-
- ^ self systemNavigation allCallsOn: aSymbol from: self .
!
Item was added:
+ ----- Method: Behavior>>allLocalCallsOn: (in category '*System-Support') -----
+ allLocalCallsOn: aSymbol
+ "Answer a sorted collection of all the methods that call on aSymbol, anywhere in my class hierarchy."
+
+ ^self systemNavigation allCallsOn: aSymbol from: self theNonMetaClass!
Item was changed:
+ ----- Method: Behavior>>allUnsentMessages (in category '*System-Support') -----
- ----- Method: Behavior>>allUnsentMessages (in category '*system-support') -----
allUnsentMessages
"Answer an array of all the messages defined by the receiver that are not sent anywhere in the system."
+ ^self systemNavigation allUnSentMessagesIn: self selectors!
- ^ SystemNavigation default allUnSentMessagesIn: self selectors!
Item was changed:
----- Method: SystemNavigation>>allImplementedMessages (in category 'query') -----
allImplementedMessages
+ "Answer a set of all the messages that are implemented in the system."
+
+ ^self allImplementedMessagesWithout: #(() ())!
- "Answer a Set of all the messages that are implemented in the system."
- ^ self allImplementedMessagesWithout: {{}. {}}!
Item was changed:
----- Method: SystemNavigation>>allImplementedMessagesWithout: (in category 'query') -----
+ allImplementedMessagesWithout: behaviorsAndSelectorsPair
+ "Answer a set of all the selectors that are implemented in the system, computed in the absence of the supplied behaviors and selectors."
+
+ | selectors behaviorsToReject |
+ selectors := IdentitySet new.
+ behaviorsToReject := behaviorsAndSelectorsPair first asIdentitySet.
+ Smalltalk allClassesAndTraitsDo: [ :behavior |
+ (behaviorsToReject includes: behavior name) ifFalse: [
+ selectors
+ addAll: behavior selectors;
+ addAll: behavior classSide selectors ] ].
+ behaviorsAndSelectorsPair second do: [ :each |
+ selectors remove: each ].
+ ^selectors!
- allImplementedMessagesWithout: classesAndMessagesPair
- "Answer a Set of all the messages that are implemented in the system,
- computed in the absence of the supplied classes and messages. Note this
- reports messages that are in the absent selectors set."
- | messages absentClasses |
- messages := IdentitySet new: CompiledMethod instanceCount.
- absentClasses := classesAndMessagesPair first.
- self flag: #shouldBeRewrittenUsingSmalltalkAllClassesDo:. "sd 29/04/03"
- Cursor execute showWhile: [
- Smalltalk classNames , Smalltalk traitNames
- do: [:name | ((absentClasses includes: name)
- ifTrue: [{}]
- ifFalse: [{Smalltalk at: name. (Smalltalk at: name) classSide}])
- do: [:each | messages addAll: each selectors]]].
- ^ messages!
Item was changed:
----- Method: SystemNavigation>>allImplementorsOf: (in category 'query') -----
allImplementorsOf: aSelector
+ "Answer a sorted collection of all the methods which are named aSelector."
+
+ | result |
+ result := OrderedCollection new.
+ self allBehaviorsDo: [ :class |
+ (class includesSelector: aSelector) ifTrue: [
+ result add: (MethodReference class: class selector: aSelector) ] ].
+ ^result sort!
- "Answer a SortedCollection of all the methods that implement the message
- aSelector."
- | aCollection |
- aCollection := SortedCollection new.
- Cursor wait
- showWhile: [self
- allBehaviorsDo: [:class | (class includesSelector: aSelector)
- ifTrue: [aCollection
- add: (MethodReference new setStandardClass: class methodSymbol: aSelector)]]].
- ^ aCollection!
Item was changed:
----- Method: SystemNavigation>>allImplementorsOf:localTo: (in category 'query') -----
allImplementorsOf: aSelector localTo: aClass
+ "Answer a sorted collection of all the methods that are named aSelector in, above, or below the given class."
+
+ | result |
+ result := OrderedCollection new.
+ { aClass theNonMetaClass. aClass theMetaClass } do: [ :baseClass |
+ baseClass withAllSuperAndSubclassesDoGently: [ :class |
+ (class includesSelector: aSelector) ifTrue: [
+ result add: (MethodReference class: class selector: aSelector) ] ] ].
+ ^result sort!
- "Answer a SortedCollection of all the methods that implement the message
- aSelector in, above, or below the given class."
- | cls aCollection |
- aCollection := SortedCollection new.
- cls := aClass theNonMetaClass.
- Cursor wait
- showWhile: [cls
- withAllSuperAndSubclassesDoGently: [:class | (class includesSelector: aSelector)
- ifTrue: [aCollection
- add: (MethodReference new setStandardClass: class methodSymbol: aSelector)]].
- cls class
- withAllSuperAndSubclassesDoGently: [:class | (class includesSelector: aSelector)
- ifTrue: [aCollection
- add: (MethodReference new setStandardClass: class methodSymbol: aSelector)]]].
- ^ aCollection!
Item was changed:
----- Method: SystemNavigation>>allImplementorsOf:localToPackage: (in category 'query') -----
allImplementorsOf: aSelector localToPackage: packageNameOrInfo
+ "Answer a sorted collection of all the methods named aSelector in the given package."
- "Answer a SortedCollection of all the methods that implement the message
- aSelector in the given package."
+ | result |
+ result := OrderedCollection new.
+ (self packageInfoFor: packageNameOrInfo) actualMethodsDo: [ :method |
+ method selector = aSelector ifTrue: [
+ result add: method methodReference ] ].
+ ^result sort!
- | aSet |
- aSet := Set new.
- Cursor wait showWhile:
- [(self packageInfoFor: packageNameOrInfo) actualMethodsDo:
- [:m |
- (m selector = aSelector) ifTrue:
- [aSet add: m methodReference]]].
- ^aSet!
Item was changed:
----- Method: SystemNavigation>>allMethodsNoDoitsSelect: (in category 'query') -----
allMethodsNoDoitsSelect: aBlock
"Like allSelect:, but strip out Doits"
+
+ self deprecated: 'Doits are not present in MethodDictionaries anymore. Use #allMethodsSelect:'.
+ ^self allMethodsSelect: aBlock!
- | aCollection |
- aCollection := SortedCollection new.
- Cursor execute
- showWhile: [self
- allBehaviorsDo: [:class | class
- selectorsAndMethodsDo: [:sel :m | (sel isDoIt not
- and: [aBlock value: m])
- ifTrue: [aCollection
- add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]].
- ^ aCollection!
Item was changed:
----- Method: SystemNavigation>>allMethodsSelect: (in category 'query') -----
allMethodsSelect: aBlock
+ "Answer a sorted collection of each method that, when used as the block
- "Answer a SortedCollection of each method that, when used as the block
argument to aBlock, gives a true result."
+
+ | result |
+ result := OrderedCollection new.
+ self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ (aBlock value: method) ifTrue: [
+ result add: (MethodReference class: behavior selector: selector) ] ].
+ ^result sort!
- | aCollection |
- aCollection := OrderedCollection new.
- Cursor execute
- showWhile: [self
- allBehaviorsDo: [:class | class
- selectorsAndMethodsDo: [:sel :m | (aBlock value: m)
- ifTrue: [aCollection
- add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]].
- ^ aCollection sort!
Item was changed:
----- Method: SystemNavigation>>allMethodsSelect:localToPackage: (in category 'query') -----
allMethodsSelect: aBlock localToPackage: packageNameOrInfo
+ "Answer a sorted collection of each method in the given package for which the evaluation of aBlock with the method answers true."
- "Answer a SortedCollection of each method in the given package
- for which the evaluation of aBlock with the metnod answers true."
+ | result |
+ result := OrderedCollection new.
+ (self packageInfoFor: packageNameOrInfo) actualMethodsDo: [ :aMethod |
+ (aBlock value: aMethod) ifTrue: [
+ result add: aMethod methodReference ] ].
+ ^result sort!
- | aSet |
- aSet := Set new.
- Cursor wait showWhile:
- [(self packageInfoFor: packageNameOrInfo) actualMethodsDo:
- [:aMethod |
- (aBlock value: aMethod) ifTrue:
- [aSet add: aMethod methodReference]]].
- ^aSet!
Item was changed:
----- Method: SystemNavigation>>allMethodsWithSourceString:matchCase: (in category 'query') -----
allMethodsWithSourceString: aString matchCase: caseSensitive
+ "Answer a sorted collection of all the methods that contain, in source code, aString as a substring. Search the class comments also"
- "Answer a SortedCollection of all the methods that contain, in source code, aString as a substring. Search the class comments also"
+ | result |
+ result := OrderedCollection new.
+ CurrentReadOnlySourceFiles cacheDuring: [
+ 'Searching all source code...'
+ displayProgressFrom: 0 to: Smalltalk classNames size
+ during: [ :bar |
+ | count previousBehavior |
+ count := 0.
+ previousBehavior := nil.
+ self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ behavior == previousBehavior ifFalse: [
+ bar value: (count := count + 1).
+ previousBehavior := behavior.
+ (behavior organization classComment asString
+ includesSubstring: aString
+ caseSensitive: caseSensitive) ifTrue: [
+ result add: (MethodReference class: behavior selector: #Comment) ] ].
+ (method getSource asString
+ includesSubstring: aString
+ caseSensitive: caseSensitive) ifTrue: [
+ result add: (MethodReference class: behavior selector: selector) ] ] ] ].
+ ^result sort!
- | list adder |
- list := Set new.
- adder := [ :mrClass :mrSel | list add: ( MethodReference new
- setStandardClass: mrClass
- methodSymbol: mrSel)].
- 'Searching all source code...'
- displayProgressFrom: 0 to: Smalltalk classNames size
- during: [:bar | | count |
- count := 0.
- SystemNavigation default allBehaviorsDo: [:each |
- bar value: (count := count + 1).
- each selectorsDo: [:sel |
- ((each sourceCodeAt: sel) findString: aString
- startingAt: 1 caseSensitive: caseSensitive) > 0 ifTrue: [
- sel isDoIt ifFalse: [adder value: each value: sel]]].
- (each organization classComment asString findString: aString
- startingAt: 1 caseSensitive: caseSensitive) > 0 ifTrue: [
- adder value: each value: #Comment] ]].
- ^ list asSortedCollection!
Item was changed:
----- Method: SystemNavigation>>allPrimitiveMethods (in category 'query') -----
allPrimitiveMethods
+ "Answer a collection of all the methods that are implemented by primitives."
+
+ | result |
+ result := OrderedCollection new.
+ self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ method primitive ~= 0 ifTrue: [
+ result add: (String streamContents: [ :stream |
+ stream
+ nextPutAll: behavior name;
+ space;
+ nextPutAll: selector;
+ space;
+ print: method primitive ]) ] ].
+ ^result!
- "Answer an OrderedCollection of all the methods that are implemented by primitives."
- | aColl |
- aColl := OrderedCollection new: 200.
- Cursor execute
- showWhile: [self allBehaviorsDo: [:class | class
- selectorsAndMethodsDo: [:sel :method |
- method primitive ~= 0
- ifTrue: [aColl addLast: class name , ' ' , sel , ' ' , method primitive printString]]]].
- ^ aColl!
Item was changed:
----- Method: SystemNavigation>>allPrimitiveMethodsInCategories: (in category 'query') -----
allPrimitiveMethodsInCategories: aList
"Answer an OrderedCollection of all the methods that are implemented by
primitives in the given categories. 1/26/96 sw"
"SystemNavigation new allPrimitiveMethodsInCategories:
#('Collections-Streams' 'Files-Streams' 'Files-Abstract' 'Files-Macintosh')"
+ | result categories |
+ result := OrderedCollection new.
+ categories := aList collect: [ :each | each asSymbol ].
+ categories size > 10 ifTrue: [ categories := categories asIdentitySet ].
+ self allBehaviorsDo: [ :behavior |
+ (aList includes: behavior category) ifTrue: [
+ behavior selectorsAndMethodsDo: [ :selector :method |
+ method primitive ~= 0 ifTrue: [
+ result add: (String streamContents: [ :stream |
+ stream
+ nextPutAll: behavior name;
+ space;
+ nextPutAll: selector;
+ space;
+ print: method primitive ]) ] ] ] ].
+ ^result!
- | aColl |
- aColl := OrderedCollection new: 200.
- Cursor execute
- showWhile: [self
- allBehaviorsDo: [:aClass | (aList includes: (SystemOrganization categoryOfElement: aClass theNonMetaClass name asString) asString)
- ifTrue: [aClass
- selectorsAndMethodsDo: [:sel :method |
- method primitive ~= 0
- ifTrue: [aColl addLast: aClass name , ' ' , sel , ' ' , method primitive printString]]]]].
- ^ aColl!
Item was added:
+ ----- Method: SystemNavigation>>allSelect: (in category 'query') -----
+ allSelect: aBlock
+ "Answer a sorted collection of each method that, when used as the block argument to aBlock, gives a true result."
+
+ | result |
+ result := OrderedCollection new.
+ self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ (aBlock value: method) ifTrue: [
+ result add: behavior name , ' ' , selector ] ].
+ ^result sort!
Item was added:
+ ----- Method: SystemNavigation>>allSelectorsAndMethodsDo: (in category 'query') -----
+ allSelectorsAndMethodsDo: aBlock
+ "Evaluate aBlock for all selectors and methods of all behaviors in this image."
+
+ self allBehaviorsDo: [ :behavior |
+ behavior selectorsAndMethodsDo: [ :selector :method |
+ aBlock value: behavior value: selector value: method ] ]!
Item was added:
+ ----- Method: SystemNavigation>>allUncommentedMethodsWithInitials: (in category 'query') -----
+ allUncommentedMethodsWithInitials: targetInitials
+ "Return a sorted collection with all uncommented methods whose initials (in the
+ time-stamp, as logged to disk) match the given initials, in chronological order."
+
+ ^CurrentReadOnlySourceFiles cacheDuring: [
+ | result |
+ result := OrderedCollection new.
+ self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ method timeStamp ifNotEmptyDo: [ :timeStamp |
+ | initials |
+ initials := timeStamp substrings first.
+ initials first isDigit ifFalse: [
+ (initials = targetInitials and: [
+ (behavior firstPrecodeCommentFor: selector) isNil ]) ifTrue: [
+ result add: (MethodReference
+ class: behavior
+ selector: selector ) ] ] ] ].
+ result ]!
Item was changed:
----- Method: SystemNavigation>>allUnimplementedCalls (in category 'query') -----
allUnimplementedCalls
+ "Answer a collection of each message that is sent by an expression in a method but is not implemented by any object in the system."
+
+ | result implementedMessages |
+ implementedMessages := self allImplementedMessages.
+ result := OrderedCollection new.
+ self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ method messagesDo: [ :each |
+ (implementedMessages includes: each) ifFalse: [
+ result add: (String streamContents: [ :stream |
+ stream
+ nextPutAll: behavior name;
+ space;
+ nextPutAll: selector;
+ space;
+ nextPutAll: 'calls: ';
+ nextPutAll: each ]) ] ] ].
+ ^result!
- "Answer an Array of each message that is sent by an expression in a
- method but is not implemented by any object in the system."
- | aStream all |
- all := self allImplementedMessages.
- aStream := WriteStream
- on: (Array new: 50).
- Cursor execute
- showWhile: [self
- allBehaviorsDo: [:cl | cl
- selectorsAndMethodsDo: [:sel :method |
- | secondStream |
- secondStream := WriteStream
- on: (String new: 5).
- method messages
- do: [:m | (all includes: m)
- ifFalse: [secondStream nextPutAll: m;
- space]].
- secondStream position = 0
- ifFalse: [aStream nextPut: cl name , ' ' , sel , ' calls: ' , secondStream contents]]]].
- ^ aStream contents!
Item was changed:
----- Method: SystemNavigation>>allUnimplementedNonPrimitiveCalls (in category 'query') -----
allUnimplementedNonPrimitiveCalls
+ "Answer an collection of each message that is sent by an expression in a method but is not implemented by any object in the system. This list won't include primitive methods."
+
+ | result implementedMessages |
+ implementedMessages := self allImplementedMessages.
+ result := OrderedCollection new.
+ self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ method primitive = 0 ifTrue: [
+ method messagesDo: [ :each |
+ (implementedMessages includes: each) ifFalse: [
+ result add: (String streamContents: [ :stream |
+ stream
+ nextPutAll: behavior name;
+ space;
+ nextPutAll: selector;
+ space;
+ nextPutAll: 'calls: ';
+ nextPutAll: each ]) ] ] ] ].
+ ^result!
- "Answer an Array of each message that is sent by an expression in a
- method but is not implemented by any object in the system."
- | aStream all |
- all := self systemNavigation allImplementedMessages.
- aStream := WriteStream
- on: (Array new: 50).
- Cursor execute
- showWhile: [self systemNavigation
- allBehaviorsDo: [:cl | cl
- selectorsAndMethodsDo: [:sel :meth |
- | secondStream |
- secondStream := WriteStream
- on: (String new: 5).
- meth primitive = 0 ifTrue: [
- meth messages
- do: [:m | (all includes: m)
- ifFalse: [secondStream nextPutAll: m;
- space]].
- secondStream position = 0
- ifFalse: [aStream nextPut: cl name , ' ' , sel , ' calls: ' , secondStream contents]]]]].
- ^ aStream contents!
Item was changed:
----- Method: SystemNavigation>>browseAllImplementorsOfList:title: (in category 'browse') -----
browseAllImplementorsOfList: selectorList title: aTitle
+ "Create and schedule a message browser on each method that implements the message whose selector is in the argument selectorList."
+ "For example, self new browseAllImplementorsOf: #(at:put: size). "
+
+ | implementorLists |
+ implementorLists := selectorList gather: [:each |
+ self allImplementorsOf: each ].
+ implementorLists sort.
+ ^self browseMessageList: implementorLists name: aTitle!
- "Create and schedule a message browser on each method that implements
- the message whose selector is in the argument selectorList. For
- example,
- self new browseAllImplementorsOf: #(at:put: size).
- 1/16/96 sw: this variant adds the title argument.
- 1/24/96 sw: use a SortedCollection
- 2/1/96 sw: show normal cursor"
- | implementorLists flattenedList |
- implementorLists := selectorList
- collect: [:each | self allImplementorsOf: each].
- flattenedList := SortedCollection new.
- implementorLists
- do: [:each | flattenedList addAll: each].
- Cursor normal show.
- ^ self browseMessageList: flattenedList name: aTitle!
Item was changed:
----- Method: SystemNavigation>>browseAllSelect:name:autoSelect: (in category 'browse') -----
browseAllSelect: aBlock name: aName autoSelect: autoSelectString
"Create and schedule a message browser on each method that, when used
as the block argument to aBlock gives a true result. Do not return an
#DoIt traces."
"self new browseAllSelect: [:method | method numLiterals > 10] name:
'Methods with more than 10 literals' autoSelect: 'isDigit'"
^ self
+ browseMessageList: [ self allMethodsSelect: aBlock ]
- browseMessageList: (self allMethodsNoDoitsSelect: aBlock)
name: aName
autoSelect: autoSelectString!
Item was changed:
----- Method: SystemNavigation>>browseMethodsWhoseNamesContain: (in category 'browse') -----
browseMethodsWhoseNamesContain: aString
"Launch a tool which shows all methods whose names contain the given string; case-insensitive.
· 1/16/1996 sw, at the dawn of Squeak: this was the classic implementation that provided the underpinning for the 'method names containing it' (cmd-shift-W) feature that has always been in Squeak -- the feature that later inspired the MethodFinder (aka SelectorBrowser).
· sw 7/27/2001: Switched to showing a MessageNames tool rather than a message-list browser, if in Morphic."
| aList |
Smalltalk isMorphic
ifFalse:
[aList := Symbol selectorsContaining: aString.
aList size > 0 ifTrue:
+ [self browseAllImplementorsOfList: aList title: 'Methods whose names contain ''', aString, '''']]
- [self browseAllImplementorsOfList: aList asSortedCollection title: 'Methods whose names contain ''', aString, '''']]
ifTrue:
[ToolSet browseMessageNames: aString]
!
Item was changed:
----- Method: SystemNavigation>>browseUncommentedMethodsWithInitials: (in category 'browse') -----
browseUncommentedMethodsWithInitials: targetInitials
+ "Browse uncommented methods whose initials (in the time-stamp, as logged to disk) match the given initials. Present them in chronological order. CAUTION: It will take several seconds for this to complete."
- "Browse uncommented methods whose initials (in the time-stamp, as logged to disk) match the given initials. Present them in chronological order. CAUTION: It will take several minutes for this to complete."
"Time millisecondsToRun: [SystemNavigation default browseUncommentedMethodsWithInitials: 'jm']"
+ self
+ browseMessageList: [ self allUncommentedMethodsWithInitials: targetInitials ]
- | methodReferences |
- methodReferences := OrderedCollection new.
- self allBehaviorsDo:
- [:aClass | aClass selectorsAndMethodsDo: [:sel :cm |
- | timeStamp initials |
- timeStamp := Utilities timeStampForMethod: cm.
- timeStamp isEmpty ifFalse:
- [initials := timeStamp substrings first.
- initials first isDigit ifFalse:
- [((initials = targetInitials) and: [(aClass firstPrecodeCommentFor: sel) isNil])
- ifTrue:
- [methodReferences add: (MethodReference new
- setStandardClass: aClass
- methodSymbol: sel)]]]]].
-
- ToolSet
- browseMessageSet: methodReferences
name: 'Uncommented methods with initials ', targetInitials
autoSelect: nil!
Item was changed:
----- Method: SystemNavigation>>selectAllMethods: (in category 'query') -----
selectAllMethods: aBlock
"Answer a SortedCollection of each method that, when used as the block
argument to aBlock, gives a true result."
+
+ self deprecated: 'Use #allMethodsSelect:'.
+ ^self allMethodsSelect: aBlock!
- | aCollection |
- aCollection := SortedCollection new.
- Cursor execute
- showWhile: [self
- allBehaviorsDo: [:class | class
- selectorsAndMethodsDo: [:sel :m | (aBlock value: m)
- ifTrue: [aCollection
- add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]].
- ^ aCollection!
Item was changed:
----- Method: SystemNavigation>>selectAllMethodsNoDoits: (in category 'query') -----
selectAllMethodsNoDoits: aBlock
"Like allSelect:, but strip out Doits"
+
+ self deprecated: 'Doits are not present in MethodDictionaries anymore. Use #allMethodsSelect:'.
+ ^self allMethodsSelect: aBlock!
- | aCollection |
- aCollection := SortedCollection new.
- Cursor execute
- showWhile: [self
- allBehaviorsDo: [:class | class
- selectorsAndMethodsDo: [:sel :m | (sel isDoIt not
- and: [aBlock value: m])
- ifTrue: [aCollection
- add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]].
- ^ aCollection!
Item was changed:
----- Method: SystemNavigation>>unimplemented (in category 'query') -----
unimplemented
+ "Answer an collection of each message that is sent by an expression in a method but is not implemented by any object in the system."
- "Answer an Array of each message that is sent by an expression in a method but is not implemented by any object in the system."
+ | implemented unimplemented |
+ implemented := self allImplementedMessages.
- | all unimplemented |
- all := IdentitySet new: Symbol instanceCount * 2.
- Cursor wait showWhile:
- [self allBehaviorsDo: [:cl | cl selectorsDo: [:aSelector | all add: aSelector]]].
-
unimplemented := IdentityDictionary new.
+ self allSelectorsAndMethodsDo: [ :behavior :selector :method |
+ method messagesDo: [ :each |
+ | entry |
+ (implemented includes: each) ifFalse: [
+ entry := unimplemented
+ at: each
+ ifPresent: [ :oldEntry |
+ oldEntry copyWith: behavior name, '>', selector ]
+ ifAbsent: [
+ { behavior name, '>', selector } ].
+ unimplemented at: each put: entry ] ] ].
+ ^unimplemented!
- Cursor execute showWhile: [
- self allBehaviorsDo: [:cl |
- cl selectorsAndMethodsDo: [:sel :meth |
- meth messages do: [:m | | entry |
- (all includes: m) ifFalse: [
- entry := unimplemented at: m ifAbsent: [Array new].
- entry := entry copyWith: (cl name, '>', sel).
- unimplemented at: m put: entry]]]]].
- ^ unimplemented
- !
Item was changed:
----- Method: SystemNavigation>>unusedBlocks (in category 'query') -----
unusedBlocks
"Answer all methods that contain a block that is not used (not
sent a message, returned, passed as an argument, or assigned)."
"SystemNavigation new unusedBlocks"
"SystemNavigation new
browseMessageList: SystemNavigation new unusedBlocks
name: 'unused blocks'"
+
+ ^self allMethodsSelect:
- ^self allSelect:
[:m| | is |
is := InstructionStream on: m.
is scanFor: [:b| b = 143 and: [(m at: is thirdByte * 256 + is fourthByte + is pc + 4) = 135]]]!
More information about the Packages
mailing list