diff -r 627302423205 -r 4131e87e79ec Class.st --- a/Class.st Mon Jul 03 04:38:27 1995 +0200 +++ b/Class.st Sat Jul 22 21:25:26 1995 +0200 @@ -12,7 +12,8 @@ ClassDescription subclass:#Class instanceVariableNames:'classvars comment subclasses classFilename package history' - classVariableNames:'UpdatingChanges FileOutErrorSignal' + classVariableNames:'UpdatingChanges FileOutErrorSignal + CatchMethodRedefinitions MethodRedefinitionSignal' poolDictionaries:'' category:'Kernel-Classes' ! @@ -21,7 +22,7 @@ COPYRIGHT (c) 1989 by Claus Gittinger All Rights Reserved -$Header: /cvs/stx/stx/libbasic/Class.st,v 1.47 1995-07-02 01:06:03 claus Exp $ +$Header: /cvs/stx/stx/libbasic/Class.st,v 1.48 1995-07-22 19:21:42 claus Exp $ '! !Class class methodsFor:'documentation'! @@ -42,7 +43,7 @@ version " -$Header: /cvs/stx/stx/libbasic/Class.st,v 1.47 1995-07-02 01:06:03 claus Exp $ +$Header: /cvs/stx/stx/libbasic/Class.st,v 1.48 1995-07-22 19:21:42 claus Exp $ " ! @@ -84,6 +85,16 @@ FileOutErrorSignal raised when an error occurs during fileOut + CatchMethodRedefinitions if true, classes protect themself + MethodRedefinitionSignal (by raising MethodRedefinitionSignal) + from redefining any existing methods, + which are defined in another package. + (i.e. a signal will be raised, if you + fileIn something which redefines an + existing method and the packages do not + match). + The default is (currently) true. + WARNING: layout known by compiler and runtime system " ! ! @@ -97,10 +108,16 @@ to avoid putting too much junk into the changes-file." UpdatingChanges := true. + CatchMethodRedefinitions := true. + FileOutErrorSignal isNil ifTrue:[ FileOutErrorSignal := Object errorSignal newSignalMayProceed:false. FileOutErrorSignal nameClass:self message:#fileOutErrorSignal. FileOutErrorSignal notifierString:'error during fileOut'. + + MethodRedefinitionSignal := Object errorSignal newSignalMayProceed:true. + MethodRedefinitionSignal nameClass:self message:#methodRedefinitionSignal. + MethodRedefinitionSignal notifierString:'attempt to redefine method from different package'. ] ! ! @@ -112,6 +129,49 @@ a fileout fails (for example due to disk-full errors)" ^ FileOutErrorSignal +! + +methodRedefinitionSignal + "return the signal raised when a method is about to be installed + which redefines an existing method and the methods packages are not + equal. This helps when filing in alien code, to prevent existing + methods to be overwritten or redefined by incompatible methods" + + ^ MethodRedefinitionSignal +! ! + +!Class class methodsFor:'accessing - flags'! + +updateChanges:aBoolean + "turn on/off changes management. Return the prior value of the flag." + + |prev| + + prev := UpdatingChanges. + UpdatingChanges := aBoolean. + ^ prev +! + +updatingChanges + "return true if changes are recorded" + + ^ UpdatingChanges +! + +catchMethodRedefinitions + "return the redefinition catching flag." + + ^ CatchMethodRedefinitions +! + +catchMethodRedefinitions:aBoolean + "turn on/off redefinition catching. Return the prior value of the flag." + + |prev| + + prev := CatchMethodRedefinitions. + CatchMethodRedefinitions := aBoolean. + ^ prev ! ! !Class class methodsFor:'enumeration '! @@ -809,6 +869,32 @@ 1st argument to the methodDictionary. Append a change record to the changes file and tell dependents." + |oldMethod| + + CatchMethodRedefinitions ifTrue:[ + "check for attempts to redefine a method + in a different package. Signal a resumable error if so. + This allows tracing redefinitions of existing system methods + when filing in alien code .... + (which we may want to forbit sometimes) + " + oldMethod := self compiledMethodAt:newSelector. + oldMethod notNil ifTrue:[ + oldMethod package ~= newMethod package ifTrue:[ + " + attempt to redefine an existing method, which was + defined in another package. + If you continue in the debugger, the new method gets installed. + Otherwise, the existing (old) method remains valid. + + You can turn of the catching of redefinitions by setting + CatchMethodRedefinitions to false + (also found in the NewLaunchers 'settings-misc' menu) + " + MethodRedefinitionSignal raise + ] + ] + ]. (super addSelector:newSelector withMethod:newMethod) ifTrue:[ self addChangeRecordForMethod:newMethod ] @@ -884,22 +970,6 @@ ]. ! -updateChanges:aBoolean - "turn on/off changes management. Return the prior value of the flag." - - |prev| - - prev := UpdatingChanges. - UpdatingChanges := aBoolean. - ^ prev -! - -updatingChanges - "return true if changes are recorded" - - ^ UpdatingChanges -! - changesStream "return a Stream for the changes file - or nil if no update is wanted" @@ -1286,9 +1356,13 @@ |cat code| Class withoutUpdatingChangesDo:[ - cat := (self compiledMethodAt:aSelector) category. - code := self sourceCodeAt:aSelector. - self compilerClass compile:code forClass:self inCategory:cat + Class methodRedefinitionSignal handle:[:ex | + ex proceed + ] do:[ + cat := (self compiledMethodAt:aSelector) category. + code := self sourceCodeAt:aSelector. + self compilerClass compile:code forClass:self inCategory:cat + ] ] ! @@ -1326,7 +1400,7 @@ |m| m := self compiledMethodAt:aSelector. - ((m code == trapCode) and:[m byteCode == trapByteCode]) ifTrue:[ + ((m code = trapCode) and:[m byteCode == trapByteCode]) ifTrue:[ self recompile:aSelector ] ] @@ -1639,7 +1713,7 @@ ] ifFalse:[ s := comment storeString ]. - aStream nextPutAll:s + aStream nextPutAll:s. aStream cr ! @@ -1795,7 +1869,7 @@ fileOutCategory:aCategory on:aStream "file out all methods belonging to aCategory, aString onto aStream" - |nMethods count sep source| + |nMethods count sep source sortedSelectors sortedMethods| methodArray notNil ifTrue:[ nMethods := 0. @@ -1814,13 +1888,21 @@ ]. aStream nextPut:$'; nextPut:sep; cr; cr. count := 1. + + "/ + "/ sort by selector + "/ + sortedSelectors := selectorArray copy. + sortedMethods := methodArray copy. + sortedSelectors sortWith:sortedMethods. + methodArray do:[:aMethod | (aCategory = aMethod category) ifTrue:[ source := aMethod source. source isNil ifTrue:[ FileOutErrorSignal raiseRequestWith:'no source for method' ] ifFalse:[ - aStream nextChunkPut:(aMethod source). + aStream nextChunkPut:source. ]. (count ~~ nMethods) ifTrue:[ aStream cr; cr @@ -1858,7 +1940,7 @@ self name , '>>' , (self selectorAtMethod:aMethod)) ] ifFalse:[ - aStream nextChunkPut:(aMethod source). + aStream nextChunkPut:source. ]. aStream space. aStream nextPut:sep. @@ -1939,7 +2021,7 @@ " methods from all categories in metaclass " - collectionOfCategories := self class categories. + collectionOfCategories := self class categories asSortedCollection. collectionOfCategories notNil ifTrue:[ " documentation first (if any) @@ -1974,7 +2056,7 @@ " methods from all categories in myself " - collectionOfCategories := self categories. + collectionOfCategories := self categories asSortedCollection. collectionOfCategories notNil ifTrue:[ collectionOfCategories do:[:aCategory | self fileOutCategory:aCategory on:aStream.