The Trunk: System-mt.1071.mcz

Marcel Taeumel uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-mt.1071.mcz

==================== Summary ====================

Name: System-mt.1071
Author: mt
Time: 12 July 2019, 10:02:46.159568 am
UUID: dc0cb024-484b-a145-af9c-e10b103db241
Ancestors: System-mt.1070

Refactoring of #literalsDo: - Step 3 of 3.

For more information, see http://forum.world.st/Please-Review-Refactoring-for-literalsDo-etc-tp5099756p5100896.html.

=============== Diff against System-mt.1070 ===============

Item was changed:
  ----- Method: DeepCopier>>checkClass: (in category 'like fullCopy') -----
  checkClass: aClass
  | meth |
  "Check that no indexes of instance vars have changed in certain classes.  If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated.  The idea is to catch a change while it is still in the system of the programmer who made it."
 
  self checkBasicClasses. "Unlikely, but important to catch when it does happen."
 
  "Every class that implements veryDeepInner: must copy all its inst vars.  Danger is that a user will add a new instance variable and forget to copy it.  So check that the last one is mentioned in the copy method."
  (aClass includesSelector: #veryDeepInner:) ifTrue: [
  ((aClass compiledMethodAt: #veryDeepInner:) writesField: aClass instSize) ifFalse: [
  aClass instSize > 0 ifTrue: [
  self warnIverNotCopiedIn: aClass sel: #veryDeepInner:]]].
  (aClass includesSelector: #veryDeepCopyWith:) ifTrue: [
  meth := aClass compiledMethodAt: #veryDeepCopyWith:.
+ (meth size > 20) & (meth hasLiteral: #veryDeepCopyWith:) not ifTrue: [
- (meth size > 20) & (meth literals includes: #veryDeepCopyWith:) not ifTrue: [
  (meth writesField: aClass instSize) ifFalse: [
  self warnIverNotCopiedIn: aClass sel: #veryDeepCopyWith:]]].
  !

Item was changed:
  ----- Method: DeepCopier>>checkVariables (in category 'like fullCopy') -----
  checkVariables
  "Check that no indexes of instance vars have changed in certain classes.  If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated.  The idea is to catch a change while it is still in the system of the programmer who made it.  
  DeepCopier new checkVariables "
 
  self checkBasicClasses.
 
  "Every class that implements veryDeepInner: must copy all its inst vars.  Danger is that a user will add a new instance variable and forget to copy it.  So check that the last one is mentioned in the copy method."
  (self systemNavigation allClassesImplementing: #veryDeepInner:) do:
  [:aClass |
  ((aClass compiledMethodAt: #veryDeepInner:) writesField: aClass instSize)
  ifFalse:
  [aClass instSize > 0
  ifTrue: [self warnIverNotCopiedIn: aClass sel: #veryDeepInner:]]].
  (self systemNavigation allClassesImplementing: #veryDeepCopyWith:) do:
  [:aClass |
  | meth |
  meth := aClass compiledMethodAt: #veryDeepCopyWith:.
+ meth size > 20 & (meth hasLiteral: #veryDeepCopyWith:) not
- meth size > 20 & (meth literals includes: #veryDeepCopyWith:) not
  ifTrue:
  [(meth writesField: aClass instSize)
  ifFalse: [self warnIverNotCopiedIn: aClass sel: #veryDeepCopyWith:]]]!

Item was changed:
  ----- Method: SystemDictionary>>isThisBindingReferred: (in category 'classes and traits') -----
  isThisBindingReferred: binding
 
  self systemNavigation allSelectorsAndMethodsDo: [ :behavior :selector :method |
  (method instVarsInclude: binding) ifTrue: [
+ method allLiteralsDo: [ :literal | "Avoid possible false positives from the primitive."
- method literalsDo: [ :literal | "Avoid possible false positives from the primitive."
  literal == binding ifTrue: [ ^true ] ] ] ].
  ^false!

Item was changed:
  Object subclass: #SystemNavigation
  instanceVariableNames: 'browserClass hierarchyBrowserClass environment'
+ classVariableNames: 'Authors AuthorsInverted Default'
- classVariableNames: 'Authors AuthorsInverted Default ThoroughSenders'
  poolDictionaries: ''
  category: 'System-Support'!
 
  !SystemNavigation commentStamp: 'mha 8/26/2010 09:02' prior: 0!
  I support the navigation of the system. I act as a facade but as I could require some state
  or different way of navigating the system all my behavior are on the instance side.
 
 
  For example if you want to look at all methods you have written or changed in the current image do
 
  SystemNavigation new browseAllSelect: [ :method |
         method fileIndex > 1 "only look at changes file"
         and: [ method timeStamp beginsWith: 'your-initials-here' ] ].
 
  !

Item was removed:
- ----- Method: SystemNavigation class>>thoroughSenders (in category 'preferences') -----
- thoroughSenders
- "Accessor for the system-wide preference"
-
- <preference: 'Thorough senders.'
- category: #general
- description: 'If true, then ''senders'' browsers will dive inside structured literals in their search.'
- type: #Boolean>
- ^ThoroughSenders ifNil: [ true ]!

Item was removed:
- ----- Method: SystemNavigation class>>thoroughSenders: (in category 'preferences') -----
- thoroughSenders: aBoolean
- "Accessor for the system-wide preference"
-
- ThoroughSenders := aBoolean!

Item was changed:
  ----- Method: SystemNavigation>>allCallsOn:fromBehaviors:sorted: (in category 'query') -----
  allCallsOn: aLiteral fromBehaviors: behaviors sorted: sorted
  "Answer a collection of all the methods implemented by behaviors that call on aLiteral even deeply embedded in literal arrays."
 
  | result |
  result := OrderedCollection new.
+ behaviors do: [:behavior |
+ behavior selectorsAndMethodsDo: [:selector :method |
+ (method hasLiteral: aLiteral)
+ ifTrue: [result addLast: method methodReference]]].
+ sorted ifTrue: [result sort].
- CompiledCode
- scanBlocksForLiteral: aLiteral
- do: [:primaryScanner :secondaryScanner | | thorough |
- "Possibly search for literals embedded in literal arrays or pragmas, etc."
- thorough := self class thoroughSenders.
- behaviors do:
- [ :behavior |
- behavior selectorsAndMethodsDo:
- [ :selector :method |
- (method
- refersTo: aLiteral
- primaryBytecodeScanner: primaryScanner
- secondaryBytecodeScanner: secondaryScanner
- thorough: thorough) ifTrue:
- [result addLast: (MethodReference class: behavior selector: selector)]]]].
- sorted ifTrue:
- [result sort].
  ^result!

Item was changed:
  ----- Method: SystemNavigation>>allCallsOn:fromMethodReferences:sorted: (in category 'query') -----
  allCallsOn: aLiteral fromMethodReferences: methodReferences sorted: sorted
  "Answer a collection of all the methods implemented by behaviors that call on aLiteral even deeply embedded in literal arrays."
 
  | result |
+ result := methodReferences select: [:reference |
+ reference compiledMethod
+ ifNil: [false]
+ ifNotNil: [:method | method hasLiteral: aLiteral]].
+ sorted ifTrue: [result sort].
- result := CompiledCode
- scanBlocksForLiteral: aLiteral
- do: [:primaryScanner :secondaryScanner | | thorough |
- "Possibly search for literals embedded in literal arrays or pragmas, etc."
- thorough := self class thoroughSenders.
- methodReferences select:
- [ :reference |
- reference compiledMethod
- ifNil: [false]
- ifNotNil:
- [:method|
- method
- refersTo: aLiteral
- primaryBytecodeScanner: primaryScanner
- secondaryBytecodeScanner: secondaryScanner
- thorough: thorough]]].
- sorted ifTrue:
- [result sort].
  ^result!

Item was changed:
  ----- Method: SystemNavigation>>allCallsOnClass: (in category 'query') -----
  allCallsOnClass: aBehavior
  "Answer a sorted collection of all the methods that refer to aBehavior."
 
  | theClass result |
  theClass := aBehavior theNonMetaClass.
  result := self
+ allCallsOn: theClass name
- allCallsOn: (
- self class thoroughSenders
- ifTrue: [  theClass name ]
- ifFalse: [ theClass environment bindingOf: theClass name ])
  fromBehaviors: self allBehaviors
  sorted: false.
  theClass environment allClassesDo: [ :class |
  (class sharedPools includes: theClass) ifTrue: [
  result add: (ClassReference class: class) ] ].
  ^result sort!

Item was changed:
  ----- Method: SystemNavigation>>allGlobalRefsWithout: (in category 'query') -----
  allGlobalRefsWithout: classesAndMessagesPair
  "Answer a set of symbols that may be refs to Global names. In some  
  sense we should only need the associations, but this will also catch, eg,  
  HTML tag types. This method computes its result in the absence of  
  specified classes and messages."
  "may be a problem if namespaces are introduced as for the moment  
  only Smalltalk is queried. sd 29/4/03"
  | globalRefs absentClasses absentSelectors |
  globalRefs := IdentitySet new: CompiledMethod instanceCount.
  absentClasses := classesAndMessagesPair first.
  absentSelectors := classesAndMessagesPair second.
  "sd 29/04/03"
  Cursor execute
  showWhile: [self environment allClassesDo:
  [:cls | ((absentClasses includes: cls name)
  ifTrue: [{}]
  ifFalse: [{cls. cls class}])
  do: [:cl | (absentSelectors isEmpty
  ifTrue: [cl selectors]
  ifFalse: [cl selectors copyWithoutAll: absentSelectors])
  do: [:sel | "Include all capitalized symbols for good
  measure"
+ (cl compiledMethodAt: sel) allLiteralsDo: [:m |
- (cl compiledMethodAt: sel) literalsDo: [:m |
  ((m isSymbol)
  and: [m size > 0
  and: [m first canBeGlobalVarInitial]])
  ifTrue: [globalRefs add: m].
+ ]]]]].
- (m isMemberOf: Array)
- ifTrue: [m
- do: [:x | ((x isSymbol)
- and: [x size > 0
- and: [x first canBeGlobalVarInitial]])
- ifTrue: [globalRefs add: x]]].
- m isVariableBinding
- ifTrue: [m key
- ifNotNil: [globalRefs add: m key]]]]]]].
  ^ globalRefs!

Item was changed:
  ----- Method: SystemNavigation>>allSentMessagesWithout: (in category 'query') -----
  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.
  "sd 29/04/03"
  Cursor execute showWhile: [
  self environment allClassesAndTraitsDo: [:cls |
  ((absentClasses includes: cls name)
  ifTrue: [{}]
  ifFalse: [{cls. cls classSide}])
  do: [:each | (absentSelectors isEmpty
  ifTrue: [each selectors]
  ifFalse: [each selectors copyWithoutAll: absentSelectors])
  do: [:sel | "Include all sels, but not if sent by self"
+ (each compiledMethodAt: sel) allLiteralsDo: [:m |
- (each compiledMethodAt: sel) literalsDo: [:m |
  (m isSymbol)
  ifTrue: ["might be sent"
  m == sel
  ifFalse: [sent add: m]].
+ ]]]]].
- (m isMemberOf: Array)
- ifTrue: ["might be performed"
- m
- do: [:x | (x isSymbol)
- ifTrue: [x == sel
- ifFalse: [sent add: x]]]]]]]]].
  "The following may be sent without being in any literal frame"
  Smalltalk specialSelectorNames do: [:sel | sent add: sel].
  Smalltalk presumedSentMessages do: [:sel | sent add: sel].
  ^ sent.!