Merge pull request #544 from GemTalk/masterV1.2

v1.2.10 release

platforms/gemstone/bin/packing_oscar

@@ -38,6 +38,7 @@ set -e
 # 1.2.6 $ROWAN_PROJECTS_HOME/Rowan/platforms/gemstone/bin/packing_oscar Edelweiss-1.2.6 v1.2.6 Oscar-3.0.65
 # 1.2.7 $ROWAN_PROJECTS_HOME/Rowan/platforms/gemstone/bin/packing_oscar Edelweiss-1.2.7 v1.2.7 Oscar-3.0.85
 # 1.2.8 $ROWAN_PROJECTS_HOME/Rowan/platforms/gemstone/bin/packing_oscar Edelweiss-1.2.8 v1.2.8 Oscar-3.0.87
+# 1.2.9 $ROWAN_PROJECTS_HOME/Rowan/platforms/gemstone/bin/packing_oscar Edelweiss-1.2.9 v1.2.9 Oscar-3.0.89
 #
 ANSI_RED="\033[91;1m"
 ANSI_GREEN="\033[92;1m"

rowan/src/AST-Core/RBConfigurableFormatter.class.st

@@ -914,7 +914,7 @@ RBConfigurableFormatter >> with: firstCollection and: secondCollection do: aBloc
 { #category : 'private' }
 RBConfigurableFormatter >> writeString: aString [ 
 	| index |
-	index := aString lastIndexOf: Character lf ifAbsent: [0].
+	index := aString lastIndexOf: Character lf startingAt: aString size ifAbsent: [0].
 	codeStream nextPutAll: aString.
 	index > 0 
 		ifTrue: [lineStart := codeStream position - (aString size - index)]

rowan/src/AST-Kernel-Core/SequenceableCollection.extension.st

@@ -1,15 +1,5 @@
 Extension { #name : 'SequenceableCollection' }
 
-{ #category : '*ast-kernel-core' }
-SequenceableCollection >> lastIndexOf: anElement ifAbsent: exceptionBlock [
-  "Answer the index of the last occurence of anElement within the  
-	receiver. If the receiver does not contain anElement, answer the
-	result of evaluating the argument, exceptionBlock."
-
-  ^ self lastIndexOf: anElement startingAt: self size ifAbsent: exceptionBlock
-
-]
-
 { #category : '*ast-kernel-core' }
 SequenceableCollection >> lastIndexOf: anElement startingAt: lastIndex ifAbsent: exceptionBlock [
   "Answer the index of the last occurence of anElement within the  

rowan/src/Rowan-GemStone-Core/RwGsLoadedSymbolDictClassExtension.class.st

@@ -64,6 +64,36 @@ RwGsLoadedSymbolDictClassExtension >> handleClassDeletion [
 	self loadedPackage removeLoadedClassExtension: self
 ]
 
+{ #category : 'private-updating' }
+RwGsLoadedSymbolDictClassExtension >> handleClassDeletionOrNewVersion [
+	"The class is deleted if both:
+	* its name no longer resolves to a class in the classHistory of the class I remember.
+	* no class in the classHistory of the class I remember is accessible under its name.
+	If my name no longer resolves to my class, but another class in its classHistory does resolve,
+	consider it a class re-version or rename.
+	Answer true if the class still exists, false if it has been deleted."
+
+	| resolved thoseResolving |
+	resolved := Rowan image resolveClassNamed: name.
+	resolved == handle
+		ifTrue: [ ^ true ].	"Has been deleted, renamed, or a new version under the same name.
+	Answer false if deleted, set handle and answer true otherwise."
+	thoseResolving := handle classHistory reverse
+		select: [ :aClass | aClass == (Rowan image resolveClassNamed: aClass name) ].
+	thoseResolving size = 0
+		ifTrue: [ 
+			self handleClassDeletion.
+			^ false ].
+	thoseResolving size > 1
+		ifTrue: [ 
+			RwNotification
+				signal:
+					'Class history with multiple "current" members found. One associated name is '
+						, name ].
+	handle := thoseResolving first.
+	^ true
+]
+
 { #category : 'initialization' }
 RwGsLoadedSymbolDictClassExtension >> initialize [
 

rowan/src/Rowan-GemStone-Core/RwGsSymbolDictionaryRegistry.class.st

@@ -243,7 +243,7 @@ RwGsSymbolDictionaryRegistry >> addNewClassVersionToAssociation: newClass [
 
 	"a new class version is being added to the association in the receiver previously occupied by the original class"
 
-	^ self class registry_ImplementationClass addNewClassVersionToAssociation: newClass instance: self
+	self class registry_ImplementationClass addNewClassVersionToAssociation: newClass instance: self
 
 ]
 
@@ -254,7 +254,7 @@ RwGsSymbolDictionaryRegistry >> addNewClassVersionToAssociation: newClass implem
 
 	"Use for calls from classes in Rowan-GemStone-Loader package"
 
-	^ implementationClass addNewClassVersionToAssociation: newClass instance: self
+	implementationClass addNewClassVersionToAssociation: newClass instance: self
 
 ]
 

rowan/src/Rowan-GemStone-Loader/RwGsSymbolDictionaryRegistry_Implementation.class.st

@@ -161,6 +161,29 @@ RwGsSymbolDictionaryRegistry_Implementation class >> _doDeleteCompiledMethodFrom
 
 ]
 
+{ #category : 'private' }
+RwGsSymbolDictionaryRegistry_Implementation class >> _loadedClassExtensionsFor: class noNewVersion: noNewVersionBlock newVersion: newVersionBlock instance: registryInstance [
+	| loadedClassExtensionSet |
+	(class isKindOf: Class)
+		ifFalse: [ registryInstance error: 'internal error - expected a class' ].
+	loadedClassExtensionSet := registryInstance classExtensionRegistry
+		at: class classHistory
+		ifAbsent: [ 
+			"we're done here"
+			^ self ].
+	loadedClassExtensionSet
+		do: [ :loadedClassExtension | 
+			| classKey |
+			classKey := loadedClassExtension key asSymbol.
+			self
+				_symbolDictionary: registryInstance _symbolDictionary
+				associationAt: classKey
+				ifPresent: [ :assoc | 
+					assoc value == loadedClassExtension handle
+						ifTrue: [ ^ noNewVersionBlock cull: loadedClassExtension ]
+						ifFalse: [ ^ newVersionBlock cull: loadedClassExtension ] ] ]
+]
+
 { #category : 'private' }
 RwGsSymbolDictionaryRegistry_Implementation class >> _loadedClassFor: class noNewVersion: noNewVersionBlock instance: registryInstance [
 
@@ -201,9 +224,7 @@ RwGsSymbolDictionaryRegistry_Implementation class >> _loadedClassFor: class noNe
 	registryInstance
 		error:
 			'internal error - there is no assocation present in the receiver for the given class '
-				, classKey asString printString.
-	^ registryInstance
-
+				, classKey asString printString
 ]
 
 { #category : 'private' }
@@ -419,20 +440,27 @@ RwGsSymbolDictionaryRegistry_Implementation class >> addNewClassVersionToAssocia
 
 	"a new class version is being added to the association in the receiver previously occupied by the original class"
 
-	^ self 
+	self 
 		_loadedClassFor: newClass
 		noNewVersion: [ 
 			"newClass is actually not a new class version of existing class, that's okay... update properties anyway"
-			self updateClassProperties: newClass instance: registryInstance.
-			^ registryInstance ]
+			self updateClassProperties: newClass instance: registryInstance.]
 		newVersion: [ :loadedClass :assoc | 
 			"association for class is present, install in association and update the loadedthing"
 			assoc value: newClass.
 			loadedClass handleClassDeletionOrNewVersion
 				ifTrue: [ loadedClass updatePropertiesFromClassFor: registryInstance ]
 				ifFalse: [ registryInstance error: 'internal error - new version of class not properly installed' ] ]
-		instance: registryInstance
-
+		instance: registryInstance.
+	self 
+		_loadedClassExtensionsFor: newClass
+		noNewVersion: [ 
+			"newClass is actually not a new class version of existing class, that's okay... noop"
+]
+		newVersion: [ :loadedClassExtension | 
+			loadedClassExtension handleClassDeletionOrNewVersion
+				ifFalse: [ registryInstance error: 'internal error - new version of class not properly installed' ] ]
+		instance: registryInstance.
 ]
 
 { #category : 'private' }
@@ -756,7 +784,6 @@ RwGsSymbolDictionaryRegistry_Implementation class >> ensureExtensionClassNamed:
 				at: extensionClass classHistory
 				ifAbsentPut: [ IdentitySet new ]) add: loadedClassExtension ].
 	^ registryInstance
-
 ]
 
 { #category : 'package - creation api' }