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

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

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

Name: PackageInfo-Base-bf.60
Author: bf
Time: 19 April 2012, 6:14:22.792 pm
UUID: 5d2b1bd4-e647-4a86-aeb0-eb93b079ded2
Ancestors: PackageInfo-Base-bf.59

When looking up the change record for an overridden method, ignore all versions from the overriding package, to really get at the original method. (Amended: use category not method for lookup. And fix category inclusion test)

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

Item was changed:
  ----- Method: PackageInfo>>changeRecordForOverriddenMethod: (in category 'testing') -----
  changeRecordForOverriddenMethod: aMethodReference
  | sourceFilesCopy method position overridingPackages |
  overridingPackages := Set new.
+ method := aMethodReference compiledMethod.
- method := aMethodReference actualClass compiledMethodAt: aMethodReference methodSymbol.
  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].
- methodPackage := PackageOrganizer default packageOfMethod: aMethodReference 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 changed:
  ----- Method: PackageOrganizer>>packageOfMethodCategory:ofClass:ifNone: (in category 'searching') -----
  packageOfMethodCategory: categoryName ofClass: aClass ifNone: errorBlock
+ ^ self packages detect: [:ea | ea includesMethodCategory: categoryName ofClassNamed: aClass name] ifNone: errorBlock
- ^ self packages detect: [:ea | ea includesMethodCategory: categoryName ofClassNamed: aClass] ifNone: errorBlock
 
 
  !