--- a/MCMethodDefinition.st Sat Aug 20 13:39:05 2011 +0200
+++ b/MCMethodDefinition.st Sat Aug 20 13:40:49 2011 +0200
@@ -11,8 +11,10 @@
!MCMethodDefinition class methodsFor:'as yet unclassified'!
cachedDefinitions
- Definitions ifNil: [Definitions _ WeakIdentityKeyDictionary new. WeakArray addWeakDependent: Definitions].
- ^ Definitions
+ Definitions ifNil: [Definitions := WeakIdentityDictionary new. WeakArray addDependent: Definitions].
+ ^ Definitions
+
+ "Modified: / 26-08-2009 / 12:20:45 / Jaroslav Havlin <havlij6@fel.cvut.cz>"
!
className: classString
@@ -64,21 +66,23 @@
!
initialize
- Smalltalk isSmalltalkX ifFalse:[
+ "
Smalltalk addToShutDownList: self
- ]
+ "
+
+ "Modified: / 13-10-2010 / 14:12:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
shutDown
WeakArray removeWeakDependent: Definitions.
- Definitions _ nil.
+ Definitions := nil.
! !
!MCMethodDefinition methodsFor:'accessing'!
actualClass
^Smalltalk at: className
- ifPresent: [:class | classIsMeta ifTrue: [class class] ifFalse: [class]]
+ ifPresent: [:class | classIsMeta ifTrue: [class classSide] ifFalse: [class]]
!
category
@@ -94,15 +98,7 @@
!
fullTimeStamp
- ^TimeStamp fromMethodTimeStamp: timeStamp
-!
-
-load
- self actualClass
- compile: source
- classified: category
- withStamp: timeStamp
- notifying: (SyntaxError new category: category)
+ ^Timestamp fromMethodTimeStamp: timeStamp
!
selector
@@ -140,18 +136,21 @@
!MCMethodDefinition methodsFor:'comparing'!
= aDefinition
- ^(super = aDefinition)
- and: [aDefinition source = self source]
- and: [aDefinition category = self category]
- and: [aDefinition timeStamp = self timeStamp]
+ ^(super = aDefinition)
+ and: [aDefinition source = self source
+ and: [aDefinition category = self category
+ "and: [aDefinition timeStamp = self timeStamp]"]]
+
+ "Modified: / 18-08-2009 / 10:18:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 14-09-2010 / 19:03:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
hash
| hash |
- hash _ String stringHash: classIsMeta asString initialHash: 0.
- hash _ String stringHash: source initialHash: hash.
- hash _ String stringHash: category initialHash: hash.
- hash _ String stringHash: className initialHash: hash.
+ hash := String stringHash: classIsMeta asString initialHash: 0.
+ hash := String stringHash: source initialHash: hash.
+ hash := String stringHash: category initialHash: hash.
+ hash := String stringHash: className initialHash: hash.
^ hash
!
@@ -163,6 +162,22 @@
^ self className, '.', (self classIsMeta ifTrue: ['meta'] ifFalse: ['nonmeta']), '.', self selector
! !
+!MCMethodDefinition methodsFor:'converting'!
+
+asChange
+
+ ^MethodDefinitionChange new
+ mcDefinition: self;
+ className: className , (classIsMeta ifTrue:[' class'] ifFalse:['']);
+ selector: selector;
+ source: source asStringWithNativeLineEndings;
+ category: category;
+ yourself
+
+ "Created: / 13-10-2010 / 17:17:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 08-11-2010 / 17:56:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!MCMethodDefinition methodsFor:'installing'!
isExtensionMethod
@@ -174,74 +189,104 @@
^ self isExtensionMethod and: [category endsWith: '-override']
!
-postload
- self isInitializer ifTrue: [self actualClass theNonMetaClass initialize]
+load
+ | package oldMethod newMethod |
+ package := MCStXPackageQuery query.
+ oldMethod := self actualClass compiledMethodAt: self selector.
+ (oldMethod notNil and:[oldMethod package ~= package])
+ ifTrue:[Class methodRedefinitionNotification
+ raiseRequestWith: (oldMethod -> self)].
+
+ newMethod := self actualClass
+ compile: source asStringWithNativeLineEndings
+ classified: category
+ withStamp: timeStamp
+ "notifying: (SyntaxError new category: category)".
+ newMethod package: package
+
+ "Modified: / 08-11-2010 / 20:13:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+postloadOver: aDefinition
+ super postloadOver: aDefinition.
+ (self isInitializer
+ and: [ self actualClass isTrait not ]
+ and: [ aDefinition isNil or: [ self source ~= aDefinition source ] ]) ifTrue: [
+ self actualClass theNonMetaClass initialize ]
!
scanForPreviousVersion
| position prevPos prevFileIndex preamble tokens sourceFilesCopy stamp method file methodCategory |
- method _ self actualClass compiledMethodAt: selector ifAbsent: [^ nil].
- position _ method filePosition.
- sourceFilesCopy _ SourceFiles collect:
+ method := self actualClass compiledMethodAt: selector ifAbsent: [^ nil].
+ position := method filePosition.
+ sourceFilesCopy := SourceFiles collect:
[:x | x isNil ifTrue: [ nil ]
ifFalse: [x readOnlyCopy]].
[method fileIndex == 0 ifTrue: [^ nil].
- file _ sourceFilesCopy at: method fileIndex.
+ 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: [preamble _ file nextChunk].
+ whileTrue: [preamble := 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 _ ''.
+ prevPos := nil.
+ stamp := ''.
(preamble findString: 'methodsFor:' startingAt: 1) > 0
- ifTrue: [tokens _ Scanner new scanTokens: preamble]
- ifFalse: [tokens _ Array new "ie cant be back ref"].
+ ifTrue: [tokens := Scanner new scanTokens: preamble]
+ 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]
+ 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]].
+ 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'].
+ stamp := tokens at: tokens size]].
+ methodCategory := tokens after: #methodsFor: ifAbsent: ['as yet unclassifed'].
methodCategory = category ifFalse:
[methodCategory = (Smalltalk
at: #Categorizer
ifAbsent: [Smalltalk at: #ClassOrganizer])
- default ifTrue: [methodCategory _ methodCategory, ' '].
+ default ifTrue: [methodCategory := methodCategory, ' '].
^ ChangeRecord new file: file position: position type: #method
class: className category: methodCategory meta: classIsMeta stamp: stamp].
- position _ prevPos.
+ position := prevPos.
prevPos notNil ifTrue:
- [file _ sourceFilesCopy at: prevFileIndex]].
+ [file := sourceFilesCopy at: prevFileIndex]].
^ nil]
ensure: [sourceFilesCopy do: [:x | x notNil ifTrue: [x close]]]
!
unload
- | previousVersion |
- self isOverrideMethod ifTrue: [previousVersion _ self scanForPreviousVersion].
- previousVersion
- ifNil: [self actualClass ifNotNilDo: [:class | class removeSelector: selector]]
- ifNotNil: [previousVersion fileIn]
+ | previousVersion class |
+
+ (class := self actualClass) ifNotNil: [class removeSelector: selector].
+ ^self.
+
+ "Original stuff"
+
+ self isOverrideMethod ifTrue: [previousVersion := self scanForPreviousVersion].
+ previousVersion
+ ifNil: [(class := self actualClass) ifNotNil: [class removeSelector: selector]]
+ ifNotNil: [previousVersion fileIn]
+
+ "Modified: / 11-09-2010 / 18:44:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!MCMethodDefinition methodsFor:'printing'!
@@ -254,15 +299,32 @@
!
fullClassName
+ "Using #class selector for classes for backwards compatibility"
+
^ self classIsMeta
ifFalse: [self className]
- ifTrue: [self className, ' class']
+ ifTrue: [
+ (self actualClass isNil or: [ self actualClass isTrait ])
+ ifFalse: [self className, ' class']
+ ifTrue: [self className, ' classSide']]
!
summary
^ self fullClassName , '>>' , selector
! !
+!MCMethodDefinition methodsFor:'private'!
+
+existingMethodOrNil
+ | actualClass |
+ actualClass := self actualClass.
+ ^actualClass
+ ifNil:[nil]
+ ifNotNil: [actualClass compiledMethodAt:self selector]
+
+ "Modified: / 08-11-2010 / 17:41:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!MCMethodDefinition methodsFor:'serializing'!
initializeWithClassName: classString
@@ -270,13 +332,15 @@
selector: selectorString
category: catString
timeStamp: timeString
-source: sourceString
- className _ classString asSymbol.
- selector _ selectorString asSymbol.
- category _ catString asSymbol.
- timeStamp _ timeString.
- classIsMeta _ metaBoolean.
- source _ sourceString withSqueakLineEndings.
+source: sourceString
+ className := classString asSymbol.
+ selector := selectorString asSymbol.
+ category := catString asSymbol.
+ timeStamp := timeString.
+ classIsMeta := metaBoolean.
+ source := sourceString asStringWithSqueakLineEndings.
+
+ "Modified: / 12-09-2010 / 16:02:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!MCMethodDefinition methodsFor:'testing'!
@@ -292,6 +356,18 @@
isMethodDefinition
^true
+!
+
+isOverrideDefinition
+
+ | oldMethod |
+
+ oldMethod := self existingMethodOrNil.
+ ^oldMethod
+ ifNil:[false]
+ ifNotNil:[oldMethod package ~= MCStXPackageQuery query]
+
+ "Created: / 08-11-2010 / 17:29:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!MCMethodDefinition methodsFor:'visiting'!
@@ -302,12 +378,12 @@
!MCMethodDefinition class methodsFor:'documentation'!
-version
- ^ '$Header: /cvs/stx/stx/goodies/monticello/MCMethodDefinition.st,v 1.2 2009-10-26 15:25:29 cg Exp $'
+version_CVS
+ ^ '$Header: /cvs/stx/stx/goodies/monticello/MCMethodDefinition.st,v 1.3 2011-08-20 11:40:49 cg Exp $'
!
-version_CVS
- ^ '$Header: /cvs/stx/stx/goodies/monticello/MCMethodDefinition.st,v 1.2 2009-10-26 15:25:29 cg Exp $'
+version_SVN
+ ^ '§Id: MCMethodDefinition.st 24 2010-11-09 14:00:17Z vranyj1 §'
! !
MCMethodDefinition initialize!