get RwSymbolDictionaryTest>>testMethodExtensionPatchInSymbolDictionaryExtension passing (yeah)

Author: dalehenrich

tonel/Rowan-GemStone/RwGsLoadedSymbolDictClassExtension.class.st

@@ -3,3 +3,82 @@ Class {
 	#superclass : 'RwLoadedClass',
 	#category : 'Rowan-GemStone'
 }
+
+{ #category : 'instance creation' }
+RwGsLoadedSymbolDictClassExtension class >> newForClass: aClass inPackage: aLoadedPackage [
+
+	^ self new initializeForClass: aClass inPackage: aLoadedPackage
+]
+
+{ #category : 'methods' }
+RwGsLoadedSymbolDictClassExtension >> addLoadedClassMethod: aLoadedMethod [
+
+	self markPackageDirty.
+	loadedClassMethods at: aLoadedMethod key put: aLoadedMethod.
+	aLoadedMethod loadedClass: self
+]
+
+{ #category : 'methods' }
+RwGsLoadedSymbolDictClassExtension >> addLoadedInstanceMethod: aLoadedMethod [
+
+	self markPackageDirty.
+	loadedInstanceMethods at: aLoadedMethod key put: aLoadedMethod.
+	aLoadedMethod loadedClass: self
+]
+
+{ #category : 'methods' }
+RwGsLoadedSymbolDictClassExtension >> addLoadedMethod: aLoadedMethod [
+
+	aLoadedMethod classIsMeta
+		ifTrue: [self addLoadedClassMethod: aLoadedMethod]
+		ifFalse: [self addLoadedInstanceMethod: aLoadedMethod]
+]
+
+{ #category : 'initialization' }
+RwGsLoadedSymbolDictClassExtension >> initialize [
+
+	super initialize.
+	loadedInstanceMethods := KeyValueDictionary new.
+	loadedClassMethods := KeyValueDictionary new
+]
+
+{ #category : 'initialization' }
+RwGsLoadedSymbolDictClassExtension >> initializeForClass: aClass inPackage: aLoadedPackage [
+
+	self initialize.
+	name := aClass name asString.
+	handle := aClass.
+	aLoadedPackage addLoadedClassExtension: self.
+	self propertyAt: 'name' put: name
+]
+
+{ #category : 'accessing' }
+RwGsLoadedSymbolDictClassExtension >> key [
+	"Answer some token that will uniquely identify me relative to any other LoadedExtendedClass in the same package."
+
+	^name
+]
+
+{ #category : 'methods' }
+RwGsLoadedSymbolDictClassExtension >> removeLoadedClassMethod: aLoadedMethod [
+
+	self markPackageDirty.
+	loadedClassMethods removeKey: aLoadedMethod key
+		ifAbsent: [self error: 'Method not present in LoadedClassExtension']
+]
+
+{ #category : 'methods' }
+RwGsLoadedSymbolDictClassExtension >> removeLoadedInstanceMethod: aLoadedMethod [
+
+	self markPackageDirty.
+	loadedInstanceMethods removeKey: aLoadedMethod key
+		ifAbsent: [self error: 'Method not present in LoadedClassExtension']
+]
+
+{ #category : 'methods' }
+RwGsLoadedSymbolDictClassExtension >> removeLoadedMethod: aLoadedMethod [
+
+	aLoadedMethod classIsMeta
+		ifTrue: [self removeLoadedClassMethod: aLoadedMethod]
+		ifFalse: [self removeLoadedInstanceMethod: aLoadedMethod]
+]

tonel/Rowan-GemStone/RwGsPackageSymbolDictionary.class.st

@@ -4,6 +4,7 @@ Class {
 	#instVars : [
 		'packageRegistry',
 		'classRegistry',
+		'classExtensionRegistry',
 		'methodRegistry'
 	],
 	#category : 'Rowan-GemStone'
@@ -29,6 +30,7 @@ RwGsPackageSymbolDictionary >> _initializeWithoutClear: newSize [
 	super _initializeWithoutClear: newSize.
 	packageRegistry := KeyValueDictionary new.
 	classRegistry := IdentityKeyValueDictionary new.	"keyed by class classHistory"
+	classExtensionRegistry := IdentityKeyValueDictionary new.	"keyed by class classHistory"
 	methodRegistry := IdentityKeyValueDictionary new.	"keyed by compiledMethod"
 	^ self
 ]
@@ -112,7 +114,7 @@ RwGsPackageSymbolDictionary >> addClassAssociation: assoc toPackageNamed: packag
 { #category : 'method - patch api' }
 RwGsPackageSymbolDictionary >> addExtensionCompiledMethod: compiledMethod for: behavior protocol: protocolString toPackageNamed: packageName [
 
-	| methodDictionary selector protocolSymbol existing loadedMethod loadedPackage loadedClassOrExtension properties |
+	| methodDictionary selector protocolSymbol existing loadedMethod loadedPackage loadedClassExtension properties |
 	methodDictionary := behavior persistentMethodDictForEnv: 0.
 	selector := compiledMethod selector.
 	methodDictionary at: selector put: compiledMethod.
@@ -139,13 +141,17 @@ RwGsPackageSymbolDictionary >> addExtensionCompiledMethod: compiledMethod for: b
 				at: packageName
 				put: (RwGSLoadedSymbolDictPackage newNamed: packageName) ].
 
-	loadedClassOrExtension := loadedPackage
+	loadedClassExtension := loadedPackage
 		loadedClassExtensionForClass: behavior
 		ifAbsent: [ 
-			self
-				error:
-					'Internal error -- attempt to add a method to a package in which its class is neither defined nor extended.' ].
-	loadedClassOrExtension addLoadedMethod: loadedMethod
+			| class ext |
+			class := behavior theNonMetaClass.
+			ext := RwGsLoadedSymbolDictClassExtension
+				newForClass: class
+				inPackage: loadedPackage.
+			self classExtensionRegistry at: class classHistory put: ext.
+			ext ].
+	loadedClassExtension addLoadedMethod: loadedMethod
 ]
 
 { #category : 'class - patch api' }
@@ -299,6 +305,12 @@ RwGsPackageSymbolDictionary >> become: ignored [
 
 ]
 
+{ #category : 'accessing' }
+RwGsPackageSymbolDictionary >> classExtensionRegistry [
+
+	^ classExtensionRegistry
+]
+
 { #category : 'accessing' }
 RwGsPackageSymbolDictionary >> classRegistry [
 

tonel/Rowan-Tests/RwAbstractTest.class.st

@@ -252,7 +252,7 @@ RwAbstractTest >> packageDefinition: packageName classNamed: className super: su
 ]
 
 { #category : 'support' }
-RwAbstractTest >> packageDefinition: packageName extendedClassNamed: className instanceMethods: instanceMethods classMethods: classMethods [
+RwAbstractTest >> packageDefinition: packageName extendClassNamed: className instanceMethods: instanceMethods classMethods: classMethods [
 
 	^ RwPackageDefinition
 		withProperties: (Dictionary with: 'name' -> packageName)
@@ -347,13 +347,13 @@ RwAbstractTest >> packageSetDefinition: packageName classNamed: className super:
 ]
 
 { #category : 'support' }
-RwAbstractTest >> packageSetDefinition: packageName extendedClassNamed: className instanceMethods: instanceMethods classMethods: classMethods [
+RwAbstractTest >> packageSetDefinition: packageName extendClassNamed: className instanceMethods: instanceMethods classMethods: classMethods [
 
 	^ (RwPackageSetDefinition new
 		addPackage:
 			(self
 				packageDefinition: packageName
-				extendedClassNamed: className
+				extendClassNamed: className
 				instanceMethods: instanceMethods
 				classMethods: classMethods))
 		asDefinition

tonel/Rowan-Tests/RwSymbolDictionaryTest.class.st

@@ -498,7 +498,7 @@ RwSymbolDictionaryTest >> testMethodExtensionPatchInSymbolDictionaryExtension [
 	self should: [ testInstance foo = 'foo' ] raise: MessageNotUnderstood.
 
 	expectedPackage1 := self
-		packageSetDefinition: packageName1
+		packageDefinition: packageName1
 		classNamed: className
 		super: superclassName.
 
@@ -522,7 +522,7 @@ RwSymbolDictionaryTest >> testMethodExtensionPatchInSymbolDictionaryExtension [
 			(testClass categoryOfSelector: methodSelector) = methodProtocol asSymbol.
 
 	expectedPackage2 := self
-		packageSetDefinition: packageName2
+		packageDefinition: packageName2
 		extendClassNamed: className
 		instanceMethods:
 			(self