The Trunk: System-mt.1228.mcz

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

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

Name: System-mt.1228
Author: mt
Time: 18 April 2021, 6:49:05.736254 pm
UUID: 513db764-6353-204e-9724-18519504a7b5
Ancestors: System-ul.1227

Adds queries to enumerate actual domain objects for changed classes or methods.

Adds change stamps for class changes and method removal.

Note that I followed the not-so-good practice of using "Utilities changeStamp" to assure a single kind of timestamp (to sort later). In the future, we should change all this to DateAndTime and deprecate TimeStamp.

=============== Diff against System-ul.1227 ===============

Item was changed:
  ----- Method: ChangeSet>>changedClasses (in category 'class changes') -----
  changedClasses
- "Answer an OrderedCollection of changed or edited classes.
- Does not include removed classes.  Sort alphabetically by name."
 
+ ^ Array streamContents: [:stream |
+ self changedClassesDo: [:class |
+ stream nextPut: class]]!
- "Much faster to sort names first, then convert back to classes.  Because metaclasses reconstruct their name at every comparison in the sorted collection.
- 8/91 sw chgd to filter out non-existent classes (triggered by problems with class-renames"
-
- ^ self changedClassNames
- collect: [:className | Smalltalk classNamed: className]
- thenSelect: [:aClass | aClass notNil]!

Item was added:
+ ----- Method: ChangeSet>>changedClassesDo: (in category 'class changes') -----
+ changedClassesDo: block
+ "Answer an OrderedCollection of changed or edited classes.
+ Does not include removed classes.  Sort alphabetically by name."
+
+ "Much faster to sort names first, then convert back to classes.  Because metaclasses reconstruct their name at every comparison in the sorted collection.
+ 8/91 sw chgd to filter out non-existent classes (triggered by problems with class-renames"
+
+ self flag: #environmentsMissing.
+ self changedClassNames do: [:className | | record class changeTypes dateAndTime category |
+ record := changeRecords at: className.
+ class := (Smalltalk classNamed: className) ifNil: [
+ PseudoClass new
+ name: className;
+ definition: record priorDefinition;
+ yourself].
+ changeTypes := record allChangeTypes.
+ dateAndTime := [TimeStamp fromMethodTimeStamp: record timeStamp]
+ ifError: [TimeStamp epoch].
+ category := [class category] ifError: ['unknown'].
+ block
+ cull: class
+ cull: changeTypes
+ cull: dateAndTime
+ cull: category].!

Item was added:
+ ----- Method: ChangeSet>>changedMethods (in category 'method changes') -----
+ changedMethods
+
+ ^ Array streamContents: [:stream |
+ self changedMethodsDo: [:class |
+ stream nextPut: class]]!

Item was added:
+ ----- Method: ChangeSet>>changedMethodsDo: (in category 'method changes') -----
+ changedMethodsDo: block
+
+ self flag: #environmentsMissing.
+ changeRecords keysAndValuesDo: [:className :classRecord |
+ (Smalltalk classNamed: className) ifNotNil: [:class |
+ classRecord methodChanges keysAndValuesDo: [:selector :methodRecord |
+ | method category sourcePointer dateAndTime |
+ (class includesSelector: selector)
+ ifTrue: [
+ method := class compiledMethodAt: selector.
+ category := class organization categoryOfElement: selector.
+ sourcePointer := method sourcePointer.
+ dateAndTime := method timeStamp]
+ ifFalse: [ "Method was removed. Try to reconstruct information."
+ methodRecord methodInfoFromRemoval ifNotNil: [:spec |
+ sourcePointer := spec first.
+ category := spec second.
+ method := CompiledMethod toReturnSelfTrailerBytes:
+ (CompiledMethodTrailer new sourcePointer: sourcePointer).
+ method methodClass: class; selector: selector.
+ dateAndTime := spec size > 2 ifTrue: [spec third]]].
+ method ifNotNil: [
+ dateAndTime := [TimeStamp fromMethodTimeStamp: dateAndTime]
+ ifError: [TimeStamp epoch].
+ block
+ cull: method
+ cull: methodRecord changeType
+ cull: dateAndTime
+ cull: category]]]].!

Item was added:
+ ----- Method: ChangeSet>>classChanges (in category 'accessing') -----
+ classChanges
+
+ ^ changeRecords keys select:
+ [:className | (changeRecords at: className) allChangeTypes notEmpty]!

Item was changed:
  ----- Method: ChangeSet>>event: (in category 'change logging') -----
  event: anEvent
  "Hook for SystemChangeNotifier"
  anEvent itemKind = SystemChangeNotifier classKind ifTrue: [
  anEvent isRemoved
  ifTrue: [self noteRemovalOf: anEvent item].
  anEvent isAdded
  ifTrue: [self addClass: anEvent item].
  anEvent isModified
  ifTrue: [anEvent anyChanges ifTrue: [self changeClass: anEvent item from: anEvent oldItem]].
  anEvent isCommented
  ifTrue: [self commentClass: anEvent item].
  anEvent isRenamed
  ifTrue: [self renameClass: anEvent item from: anEvent oldName to: anEvent newName].
  anEvent isReorganized
  ifTrue: [self reorganizeClass: anEvent item].
  anEvent isRecategorized
  ifTrue: [self changeClass: anEvent item from: anEvent item].
  ].
 
  anEvent itemKind = SystemChangeNotifier methodKind ifTrue: [
  anEvent isAdded
  ifTrue: [self noteNewMethod: anEvent item forClass: anEvent itemClass selector: anEvent itemSelector priorMethod: nil].
  anEvent isModified
  ifTrue: [self noteNewMethod: anEvent item forClass: anEvent itemClass selector: anEvent itemSelector priorMethod: anEvent oldItem].
  anEvent isRemoved
+ ifTrue: [self removeSelector: anEvent itemSelector class: anEvent itemClass priorMethod: anEvent item lastMethodInfo: {anEvent item sourcePointer. anEvent itemProtocol. Utilities changeStamp}].
- ifTrue: [self removeSelector: anEvent itemSelector class: anEvent itemClass priorMethod: anEvent item lastMethodInfo: {anEvent item sourcePointer. anEvent itemProtocol}].
  anEvent isRecategorized
  ifTrue: [self reorganizeClass: anEvent itemClass].
  ].!

Item was changed:
  Object subclass: #ClassChangeRecord
+ instanceVariableNames: 'inForce revertable changeTypes thisDefinition priorDefinition thisName priorName thisOrganization priorOrganization thisComment priorComment thisMD priorMD methodChanges timeStamp'
- instanceVariableNames: 'inForce revertable changeTypes thisDefinition priorDefinition thisName priorName thisOrganization priorOrganization thisComment priorComment thisMD priorMD methodChanges'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'System-Changes'!
 
  !ClassChangeRecord commentStamp: 'fbs 9/6/2013 17:32' prior: 0!
  A ClassChangeRecorder keeps track of most substantive changes permissible in a project, isolated or not.
 
  Structure:
  inForce a boolean
  Tells whether these changes are in effect.
  true for all changeSets in and above the current project.
  It should be sufficient only to record this for the changeSet
  as a whole, but this redundancy could help in error recovery.
  classIsLocal a boolean
  True if and only if this class is defined in this layer of the
  project structure.
  changeTypes an identitySet
  Summarizes which changes have been made in this class.
  Values include #comment, #reorganize, #rename,
  and the four more summarized below.
  thisName a string
  Retains the class name for this layer.
  priorName a string
  Preserves the prior name.
  thisComment a text
  Retains the class comment for this layer.
  priorComment a text
  Preserves the prior comment.
  thisOrganization a classOrganizer
  Retains the class organization for this layer.
  priorOrganization a classOrganizer
  Preserves the prior organization.
  thisMD a methodDictionary
  Used to prepare changes for nearly atomic invocation
  of this layer (see below).
  priorMD a methodDictionary
  Preserves the state of an altered class as it exists in the next
  outer layer of the project structure.
  methodChanges a dictionary of classChangeRecords
  Retains all the method changes for this layer.
 
  Four of the possible changeTypes are maintained in a mutually exclusive set, analogously to MethodChangeRecords.  Here is a simple summary of the relationship between these four changeType symbols and the recording of prior state
  | prior == nil | prior not nil
  --------- |---------------------------- |--------------------
  add | add | change
  --------- |---------------------------- |--------------------
  remove | addedThenRemoved | remove
 
  A classChangeRecorder is notified of changes by the method
  noteMethodChange: <ClassChangeRecord>.
  ClassChangeRecorders are designed to invoke a set of changes relative to the definition of a class in an prior layer.  It is important that both invocation and revocation of these changes take place in a nearly atomic fashion so that interdependent changes will be adopted as a whole, and so that only one flush of the method cache should be necessary.  A further reason for revocation to be simple is that it may be requested as an attempt to recover from an error in a project that is failing.!

Item was changed:
  ----- Method: ClassChangeRecord>>noteChangeType:fromClass: (in category 'all changes') -----
  noteChangeType: changeSymbol fromClass: class
 
+ timeStamp := Utilities changeStamp.
  (changeSymbol = #new or: [changeSymbol = #add]) ifTrue:
  [changeTypes add: #add.
  changeTypes remove: #change ifAbsent: [].
  revertable := false.
  ^ self].
  changeSymbol = #change ifTrue:
  [(changeTypes includes: #add) ifTrue: [^ self].
  ^ changeTypes add: changeSymbol].
  changeSymbol == #addedThenRemoved ifTrue:
  [^ self].  "An entire class was added but then removed"
  changeSymbol = #comment ifTrue:
  [^ changeTypes add: changeSymbol].
  changeSymbol = #reorganize ifTrue:
  [^ changeTypes add: changeSymbol].
  changeSymbol = #rename ifTrue:
  [^ changeTypes add: changeSymbol].
  (changeSymbol beginsWith: 'oldName: ') ifTrue:
  ["Must only be used when assimilating other changeSets"
  (changeTypes includes: #add) ifTrue: [^ self].
  priorName := changeSymbol copyFrom: 'oldName: ' size + 1 to: changeSymbol size.
  ^ changeTypes add: #rename].
  changeSymbol = #remove ifTrue:
  [(changeTypes includes: #add)
  ifTrue: [changeTypes add: #addedThenRemoved]
  ifFalse: [changeTypes add: #remove].
  ^ changeTypes removeAllFoundIn: #(add change comment reorganize)].
 
  self error: 'Unrecognized changeType'!

Item was added:
+ ----- Method: ClassChangeRecord>>timeStamp (in category 'accessing') -----
+ timeStamp
+
+ ^ timeStamp!