--- 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.