The Trunk: PackageInfo-Base-bf.61.mcz

Bert Freudenberg uploaded a new version of PackageInfo-Base to project The Trunk:
http://source.squeak.org/trunk/PackageInfo-Base-bf.61.mcz

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

Name: PackageInfo-Base-bf.61
Author: bf
Time: 4 May 2012, 5:19:59.726 pm
UUID: b83f26b4-eb81-44a0-b6b9-a0ad3f50f290
Ancestors: PackageInfo-Base-bf.60

Factor out override scanning into changeRecordsForMethod:do: to allow use by MC, too.

=============== Diff against PackageInfo-Base-bf.60 ===============

Item was changed:
  ----- Method: PackageInfo>>changeRecordForOverriddenMethod: (in category 'testing') -----
  changeRecordForOverriddenMethod: aMethodReference
+ self changeRecordsForMethod: aMethodReference do: [:record |
+ (self includesMethodCategory: record category
+ ofClass: aMethodReference actualClass)
+ ifTrue: [^record]].
+ ^nil!
- | sourceFilesCopy method position overridingPackages |
- overridingPackages := Set new.
- method := aMethodReference compiledMethod.
- position := method filePosition.
- sourceFilesCopy := SourceFiles collect:
- [:x | x isNil ifTrue: [ nil ]
- ifFalse: [x readOnlyCopy]].
- [ | file prevPos prevFileIndex chunk stamp methodCategory methodPackage tokens |
- method fileIndex = 0 ifTrue: [^ nil].
- file := sourceFilesCopy at: method fileIndex.
- [position notNil & file notNil]
- whileTrue:
- [file position: (0 max: position-150).  "Skip back to before the preamble"
- [file position < (position-1)]  "then pick it up from the front"
- whileTrue: [chunk := file nextChunk].
-
- "Preamble is likely a linked method preamble, if we're in
- a changes file (not the sources file).  Try to parse it
- for prior source position and file index"
- prevPos := nil.
- stamp := ''.
- (chunk findString: 'methodsFor:' startingAt: 1) > 0
- ifTrue: [tokens := Scanner new scanTokens: chunk]
- ifFalse: [tokens := Array new  "ie cant be back ref"].
- ((tokens size between: 7 and: 8)
- and: [(tokens at: tokens size-5) = #methodsFor:])
- ifTrue:
- [(tokens at: tokens size-3) = #stamp:
- ifTrue: ["New format gives change stamp and unified prior pointer"
- stamp := tokens at: tokens size-2.
- prevPos := tokens last.
- prevFileIndex := sourceFilesCopy fileIndexFromSourcePointer: prevPos.
- prevPos := sourceFilesCopy filePositionFromSourcePointer: prevPos]
- ifFalse: ["Old format gives no stamp; prior pointer in two parts"
- prevPos := tokens at: tokens size-2.
- prevFileIndex := tokens last].
- (prevPos = 0 or: [prevFileIndex = 0]) ifTrue: [prevPos := nil]].
- ((tokens size between: 5 and: 6)
- and: [(tokens at: tokens size-3) = #methodsFor:])
- ifTrue:
- [(tokens at: tokens size-1) = #stamp:
- ifTrue: ["New format gives change stamp and unified prior pointer"
- stamp := tokens at: tokens size]].
- methodCategory := tokens after: #methodsFor: ifAbsent: ['as yet unclassifed'].
- (self includesMethodCategory: methodCategory ofClass: aMethodReference actualClass) ifTrue:
- [methodCategory = (Smalltalk at: #Categorizer ifAbsent: [Smalltalk at: #ClassOrganizer]) default ifTrue: [methodCategory := methodCategory, ' '].
- ^ ChangeRecord new file: file position: position type: #method
- class: aMethodReference classSymbol category: methodCategory meta: aMethodReference classIsMeta stamp: stamp].
- methodPackage := PackageOrganizer default packageOfMethodCategory: methodCategory ofClass: aMethodReference actualClass ifNone: [#unknown].
- (self isOverrideCategory: methodCategory)
- ifTrue: [overridingPackages add: methodPackage]
- ifFalse: [(overridingPackages includes: methodPackage)
- ifFalse: [^nil]].
- position := prevPos.
- prevPos notNil ifTrue:
- [file := sourceFilesCopy at: prevFileIndex]].
- ^ nil]
- ensure: [sourceFilesCopy do: [:x | x notNil ifTrue: [x close]]]
- !

Item was added:
+ ----- Method: PackageInfo>>changeRecordsForMethod:do: (in category 'enumerating') -----
+ changeRecordsForMethod: aMethodReference do: aBlock
+ "Evaluate aBlock with one ChangeRecord per overriding package, followed by the latest non-override"
+ | overridingPackages method position sourceFilesCopy |
+ overridingPackages := Set new.
+ method := aMethodReference compiledMethod.
+ position := method filePosition.
+ sourceFilesCopy := SourceFiles collect: [:x | x ifNotNil: [x readOnlyCopy]].
+ [ | file prevPos prevFileIndex chunk stamp methodCategory methodPackage tokens |
+ method fileIndex = 0 ifTrue: [^ nil].
+ file := sourceFilesCopy at: method fileIndex.
+ [position notNil & file notNil]
+ whileTrue:
+ [file position: (0 max: position-150).  "Skip back to before the preamble"
+ [file position < (position-1)]  "then pick it up from the front"
+ whileTrue: [chunk := file nextChunk].
+
+ "Preamble is likely a linked method preamble, if we're in
+ a changes file (not the sources file).  Try to parse it
+ for prior source position and file index"
+ prevPos := nil.
+ stamp := ''.
+ (chunk findString: 'methodsFor:' startingAt: 1) > 0
+ ifTrue: [tokens := Scanner new scanTokens: chunk]
+ ifFalse: [tokens := Array new  "ie cant be back ref"].
+ ((tokens size between: 7 and: 8)
+ and: [(tokens at: tokens size-5) = #methodsFor:])
+ ifTrue:
+ [(tokens at: tokens size-3) = #stamp:
+ ifTrue: ["New format gives change stamp and unified prior pointer"
+ stamp := tokens at: tokens size-2.
+ prevPos := tokens last.
+ prevFileIndex := sourceFilesCopy fileIndexFromSourcePointer: prevPos.
+ prevPos := sourceFilesCopy filePositionFromSourcePointer: prevPos]
+ ifFalse: ["Old format gives no stamp; prior pointer in two parts"
+ prevPos := tokens at: tokens size-2.
+ prevFileIndex := tokens last].
+ (prevPos = 0 or: [prevFileIndex = 0]) ifTrue: [prevPos := nil]].
+ ((tokens size between: 5 and: 6)
+ and: [(tokens at: tokens size-3) = #methodsFor:])
+ ifTrue:
+ [(tokens at: tokens size-1) = #stamp:
+ ifTrue: ["New format gives change stamp and unified prior pointer"
+ stamp := tokens at: tokens size]].
+ methodCategory := tokens after: #methodsFor: ifAbsent: [ClassOrganizer default].
+ methodPackage := PackageOrganizer default packageOfMethodCategory: methodCategory ofClass: aMethodReference actualClass ifNone: [#unknown].
+ (overridingPackages includes: methodPackage)
+ ifFalse: [aBlock value: (ChangeRecord new
+ file: file position: position type: #method
+ class: aMethodReference classSymbol category: methodCategory
+ meta: aMethodReference classIsMeta stamp: stamp)].
+ (self isOverrideCategory: methodCategory)
+ ifTrue: [overridingPackages add: methodPackage]
+ ifFalse: [(overridingPackages includes: methodPackage)
+ ifFalse: [^nil]].
+ position := prevPos.
+ prevPos notNil ifTrue:
+ [file := sourceFilesCopy at: prevFileIndex]].
+ ^nil]
+ ensure: [sourceFilesCopy do: [:x | x ifNotNil: [x close]]]
+ !

Item was changed:
  ----- Method: PackageInfo>>isOverrideCategory: (in category 'testing') -----
  isOverrideCategory: aString
+ ^ aString first = $* and: [aString endsWith: '-override']!
- ^ aString endsWith: '-override'!