[Goodie] Baddie?! Swallowing bad system categories silently, was Re: Modules at SqueakEnd

Henrik Gedenryd h.gedenryd at open.ac.uk
Fri May 3 10:12:42 UTC 2002


> 
> Is it worth setting up a more sophsticated mapping from old categories to
> new modules so we can more painlessly file in old stuff? Any hints on how
> to do this? :)

One problem: the old categories at which point? They've been changed many
times. How does the fileIn know what version of the categories were used?

I've made a cs (attached) that ignores the categories for the base image
classes. That makes it unnecessary to edit the categories, but it also
swallows any old-style category string without checking for consistency with
the new scheme. This however causes any category string to be accepted and
so makes strange bugs pass by without alarm, just ask Ted & Scott ;-) It is
bound to cause bad problems. So that's why I prefer it not to be in the
standard image. Of course improvements that solve the problems (how?) are
welcome.

Henrik

-------------- next part --------------
'From Squeak3.3alpha of 30 January 2002 [latest update: #4769] on 4 March 2002 at 6:17:22 pm'!
"Change Set:		classdefCompatibility
Date:			4 March 2002
Author:			Henrik Gedenryd

	New principles for treating old-style class definitions:
		- Always check for an existing class anywhere in the image. If it exists, always treat the class def. as a redefinition. Ignore the class category.
		- If the class doesn't exist, and the message category doesn't match any meaningful module, create a module from the category, but place it under Temporary. For example: 'XML-Parser' --> #(Temporary XML Parser)"!


!Browser methodsFor: 'system category functions' stamp: 'hg 3/4/2002 17:48'!
findClass
	"Search for a class by name."
	| pattern foundClass classNames index toMatch exactMatch potentialClassNames |

	self okToChange ifFalse: [^ self classNotFound].
	pattern _ FillInTheBlank request: 'Class name or fragment?'.
	pattern isEmpty ifTrue: [^ self classNotFound].
	toMatch _ (pattern copyWithout: $.) asLowercase.
	potentialClassNames _ self potentialClassNames asOrderedCollection.
	classNames _ pattern last = $. 
		ifTrue: [potentialClassNames select:
					[:nm |  nm asLowercase = toMatch]]
		ifFalse: [potentialClassNames select: 
					[:n | n includesSubstring: toMatch caseSensitive: false]].
	classNames isEmpty ifTrue: [^ self classNotFound].
	exactMatch _ classNames detect: [:each | each asLowercase = toMatch] ifNone: [nil].

	index _ classNames size = 1
		ifTrue:	[1]
		ifFalse:	[exactMatch
			ifNil: [(PopUpMenu labelArray: classNames lines: #()) startUp]
			ifNotNil: [classNames addFirst: exactMatch.
				(PopUpMenu labelArray: classNames lines: #(1)) startUp]].
	index = 0 ifTrue: [^ self classNotFound].
	foundClass _ Module root firstClassNamed: (classNames at: index).
 	self selectCategoryForClass: foundClass.
	self selectClass: foundClass
! !


!ClassBuilder methodsFor: 'class definition' stamp: 'hg 3/4/2002 18:03'!
name: className inModule: moduleOrPath subclassOf: newSuper type: type instanceVariableNames: instVarString classVariableNames: classVarString poolDictionaries: poolString category: category unsafe: unsafe
	"Define a new class in the given module. 
	If module is nil then this is an old-style creation message with no module supplied,
	and if category is nil then it is a new-style message.
	If unsafe is true do not run any validation checks.
	This facility is provided to implement important system changes."
	| oldClass newClass instVars classVars force assoc |
	module _ self moduleFromClassName: className moduleOrPath: moduleOrPath andCategory: category.
	instVars _ Scanner new scanFieldNames: instVarString.
	classVars _ (Scanner new scanFieldNames: classVarString) collect: [:x | x asSymbol].

	"Validate the proposed name"
	(unsafe or: [self validateClassName: className]) ifFalse:[^nil].

	assoc _ module localAssocFor: className ifAbsent:[nil].
	oldClass _ assoc ifNotNil: [assoc value].
	oldClass isBehavior 
		ifFalse:[oldClass _ nil]. "Already checked in #validateClassName:"

	unsafe ifFalse:[
		"Run validation checks so we know that we have a good chance for recompilation"
		(self validateSuperclass: newSuper forSubclass: oldClass) ifFalse:[^nil].
		(self validateInstvars: instVars from: oldClass forSuper: newSuper) ifFalse:[^nil].
		(self validateClassvars: classVars from: oldClass forSuper: newSuper) ifFalse:[^nil].
		(self validateSubclassFormat: type from: oldClass forSuper: newSuper extra: instVars size) ifFalse:[^nil]].

	"Create a template for the new class (will return oldClass when there is no change)"
	newClass _ self 
		newSubclassOf: newSuper 
		type: type 
		instanceVariables: instVars
		from: oldClass
		unsafe: unsafe.

	newClass == nil ifTrue:[^nil]. "Some error"

	newClass == oldClass ifFalse:[newClass setName: className].

	"Install the class variables and pool dictionaries... "
	force _ (newClass declare: classVarString) | (newClass sharing: poolString).

	"support old-style classification somewhat ..."
	module organization 
		classify: newClass name under: (category ifNil: [module simulatedCategory]) asSymbol.
	newClass module: module.

	"... recompile ..."
	newClass _ self recompile: force from: oldClass to: newClass mutate: false.

	[module redefineName: newClass name as: newClass export: true]
			on: AttemptToWriteReadOnlyGlobal do:[:ex| ex resume: true].
	Smalltalk flushClassNameCache.

	self doneCompiling: newClass.
	^newClass
! !

!ClassBuilder methodsFor: 'private' stamp: 'hg 3/4/2002 18:16'!
moduleFromClassName: className moduleOrPath: moduleOrPath andCategory: category
	"if new-style class definition: accept module or path
	if old-style class definition (no module or path given):
		- Always check for an existing class anywhere in the image. If it exists, always treat the class def. as a redefinition. Ignore the class category.
		- If the class doesn't exist, and the message category doesn't match any meaningful module, create a module from the category, but place it under Temporary. For example: 'XML-Parser' --> #(Temporary XML Parser)"

	| oldClass mod |
	^moduleOrPath 
		ifNil: [
			oldClass _ (Module root firstClassNamed: className).
			oldClass 
				ifNotNil: [
					Transcript show: 'Old-style class definition - Redefining existing class, system category ignored.';cr.
					oldClass module]
				ifNil: [
					Module @ (Module pathFromCategory: category create: false) ifNil: [
						mod _ Module moduleForCategory: 'Temporary-', category forceCreate: true.
						Transcript show: 'Old-style class definition - bad system category converted into module at ', mod path literalPrintString, '.';cr.
						mod]]]
		ifNotNil:[
			(moduleOrPath isKindOf: Module)
				ifTrue: [moduleOrPath]
				ifFalse: [Module fromPath: moduleOrPath forceCreate: true]]! !


!ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 3/4/2002 17:47'!
categoryOfElement: c
	"old-style use, we know that c is the name of a class"

	^(Module root firstClassNamed: c) ifNotNilDo: [:cl | cl module simulatedCategory]! !

!ModularSystemOrganizer methodsFor: 'handled SysOrg methods' stamp: 'hg 3/4/2002 17:50'!
numberOfCategoryOfElement: name 
	"Answer the index of the category with which the argument, name, is 
	associated."

	(self categoryOfElement: name) ifNotNilDo: [:categoryName |
		self categories withIndexDo: [:cat :index | 
				cat = categoryName ifTrue: [^index]]].
	^0! !


!VirtualRootModule methodsFor: 'lookups' stamp: 'hg 3/4/2002 17:46'!
firstClassNamed: name

	^self allDefinitionsFor: name onlyExported: false detect: [:value :module | 
		value isBehavior]! !


More information about the Squeak-dev mailing list