From 5505c584f4796ed6af5953988ac5bdeac9b83995 Mon Sep 17 00:00:00 2001 From: DEMAREY Christophe Date: Wed, 29 May 2024 10:56:06 +0200 Subject: [PATCH] try to fix undeclared loading --- .../SystemDictionary.extension.st | 26 +++++++++++++++++++ 1 file changed, 26 insertions(+) create mode 100644 src/PharoLauncher-100Compatibility/SystemDictionary.extension.st diff --git a/src/PharoLauncher-100Compatibility/SystemDictionary.extension.st b/src/PharoLauncher-100Compatibility/SystemDictionary.extension.st new file mode 100644 index 00000000..1712d089 --- /dev/null +++ b/src/PharoLauncher-100Compatibility/SystemDictionary.extension.st @@ -0,0 +1,26 @@ +Extension { #name : 'SystemDictionary' } + +{ #category : '*PharoLauncher-100Compatibility' } +SystemDictionary >> at: aKey put: anObject [ + "Override from Dictionary to check Undeclared and fix up + references to undeclared variables." + | index assoc registeredMethods | + aKey isSymbol ifFalse: [ self error: 'Only symbols are accepted as keys in SystemDictionary' ]. + ((self includesKey: aKey) not and: [ Undeclared includesKey: aKey ]) ifTrue: [ + | undeclared | + undeclared := Undeclared associationAt: aKey. + "Undeclared variables record using methods in a property, remove. Boostrap might have used Associations" + (undeclared class == UndeclaredVariable) ifTrue: [ + registeredMethods := undeclared removeProperty: #registeredMethods ifAbsent: [ #() ]]. + "and change class to be Global" + self add: (undeclared primitiveChangeClassTo: GlobalVariable new). + Undeclared removeKey: aKey]. + "code of super at:put:, not using Associations but GlobalVariable" + index := self findElementOrNil: aKey. + assoc := array at: index. + assoc + ifNil: [self atNewIndex: index put: (GlobalVariable key: aKey value: anObject). self flushClassNameCache] + ifNotNil: [assoc value: anObject]. + registeredMethods do: [ :aMethod | aMethod isInstalled ifTrue: [aMethod recompile] ]. + ^ anObject +]