--- a/Object.st Wed Nov 28 10:22:05 2012 +0000
+++ b/Object.st Fri Nov 30 17:19:23 2012 +0000
@@ -525,7 +525,6 @@
"Modified: 23.4.1996 / 16:00:07 / cg"
! !
-
!Object methodsFor:'Compatibility-Dolphin'!
stbFixup: anSTBInFiler at: newObjectIndex
@@ -601,12 +600,12 @@
elL3 at:3 put:(Array new:3).
copy := original copyTwoLevel.
- (original at:2) ~~ (copy at:2) ifFalse:[self halt].
- (original at:3) ~~ (copy at:3) ifFalse:[self halt].
+ self assert:((original at:2) ~~ (copy at:2)).
+ self assert:((original at:3) ~~ (copy at:3)).
copyOfElL1 := copy at:3.
- (elL1 at:2) == (copyOfElL1 at:2) ifFalse:[self halt].
- (elL1 at:3) == (copyOfElL1 at:3) ifFalse:[self halt].
+ self assert:((elL1 at:2) == (copyOfElL1 at:2)).
+ self assert:((elL1 at:3) == (copyOfElL1 at:3)).
"
!
@@ -2209,6 +2208,17 @@
|myClass sz "{ Class: SmallInteger }" t |
myClass := self class.
+
+ "process the named instance variables"
+ sz := myClass instSize.
+ 1 to:sz do:[:i |
+ t := anObject instVarAt:i.
+ aSymbol ~~ #yourself ifTrue:[
+ t := t perform:aSymbol
+ ].
+ self instVarAt:i put:t
+ ].
+
myClass isVariable ifTrue:[
sz := self basicSize.
@@ -2221,18 +2231,6 @@
self basicAt:i put:t.
]
].
-
- "process the named instance variables"
- sz := myClass instSize.
- 1 to:sz do:[:i |
- t := anObject instVarAt:i.
- aSymbol ~~ #yourself ifTrue:[
- t := t perform:aSymbol
- ].
- self instVarAt:i put:t
- ].
-
- ^ self
!
cloneInstanceVariablesFrom:aPrototype
@@ -2329,25 +2327,35 @@
This method DOES NOT handle cycles/self-refs and does NOT preserve object identity;
i.e. identical references in the source are copied multiple times into the copy."
- |newObject class index|
-
- level == 1 ifTrue:[^ self shallowCopy].
-
- class := self class.
- newObject := self clone.
- newObject == self ifTrue: [^ self].
+ |newObject newLevel class sz "{Class: SmallInteger}" newInst|
+
+ newObject := self copy.
+ newObject == self ifTrue: [^ self]. "copy of nil, true, false, ... is self"
+ level == 1 ifTrue:[^ newObject].
+ newLevel := level - 1.
+
+ class := newObject class.
+
+ "process the named instance variables"
+ sz := class instSize.
+ 1 to:sz do:[:i |
+ newInst := newObject instVarAt:i.
+ newInst notNil ifTrue:[
+ newObject instVarAt:i put:(newInst copyToLevel:newLevel).
+ ].
+ ].
+
class isVariable ifTrue:[
- index := self basicSize.
- [index > 0] whileTrue:[
- newObject basicAt: index put: ((self basicAt: index) copyToLevel:(level-1)).
- index := index - 1
+ sz := newObject basicSize.
+
+ "process the indexed instance variables"
+ 1 to:sz do:[:i |
+ newInst := newObject basicAt:i.
+ newInst notNil ifTrue:[
+ newObject basicAt:i put:(newInst copyToLevel:newLevel).
+ ].
]
].
- index := class instSize.
- [index > 0] whileTrue:[
- newObject instVarAt: index put: ((self instVarAt: index) copyToLevel:(level-1)).
- index := index - 1
- ].
^ newObject
"
@@ -2462,34 +2470,48 @@
This method DOES handle cycles/self references."
|myClass aCopy
- sz "{ Class: SmallInteger }"
+ basicSize "{ Class: SmallInteger }"
+ instSize "{ Class: SmallInteger }"
iOrig iCopy|
myClass := self class.
-"/ (myClass whichClassImplements:#deepCopyUsing:) ~~ Object ifTrue:[
-"/ ^ self deepCopyUsing:aDictionary.
-"/ ].
-
myClass isVariable ifTrue:[
- sz := self basicSize.
- aCopy := myClass basicNew:sz.
+ basicSize := self basicSize.
+ aCopy := myClass basicNew:basicSize.
] ifFalse:[
- sz := 0.
+ basicSize := 0.
aCopy := myClass basicNew
].
aCopy setHashFrom:self.
aDictionary at:self put:aCopy.
"
+ copy the instance variables
+ "
+ instSize := myClass instSize.
+ 1 to:instSize do:[:i |
+ (self skipInstvarIndexInDeepCopy:i) ifFalse:[
+ iOrig := self instVarAt:i.
+ iOrig notNil ifTrue:[
+ iCopy := aDictionary at:iOrig ifAbsent:nil.
+ iCopy isNil ifTrue:[
+ iCopy := iOrig deepCopyUsing:aDictionary postCopySelector:postCopySelector
+ ].
+ aCopy instVarAt:i put:iCopy
+ ]
+ ]
+ ].
+
+ "
copy indexed instvars - if any
"
- sz ~~ 0 ifTrue:[
+ basicSize ~~ 0 ifTrue:[
myClass isBits ifTrue:[
"block-copy indexed instvars"
- aCopy replaceFrom:1 to:sz with:self startingAt:1
+ aCopy replaceFrom:1 to:basicSize with:self startingAt:1
] ifFalse:[
"individual deep copy the indexed variables"
- 1 to:sz do:[:i |
+ 1 to:basicSize do:[:i |
iOrig := self basicAt:i.
iOrig notNil ifTrue:[
"/ used to be dict-includesKey-ifTrue[dict-at:],
@@ -2504,22 +2526,6 @@
]
].
- "
- copy the instance variables
- "
- sz := myClass instSize.
- 1 to:sz do:[:i |
- (self skipInstvarIndexInDeepCopy:i) ifFalse:[
- iOrig := self instVarAt:i.
- iOrig notNil ifTrue:[
- iCopy := aDictionary at:iOrig ifAbsent:nil.
- iCopy isNil ifTrue:[
- iCopy := iOrig deepCopyUsing:aDictionary postCopySelector:postCopySelector
- ].
- aCopy instVarAt:i put:iCopy
- ]
- ]
- ].
aCopy perform:postCopySelector withOptionalArgument:self and:aDictionary.
^ aCopy
@@ -3838,7 +3844,7 @@
is not clear which method to execute in response to
aMessage.
Such situation may occur when a current selector namespace
- imports two namespaces and both defines method with
+ imports two namespaces and both define a method with the
requested selector."
<context: #return>
@@ -3847,6 +3853,7 @@
^ AmbiguousMessage raiseRequestWith:aMessage
"Created: / 21-07-2010 / 15:44:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 02-11-2012 / 10:14:42 / cg"
!
appropriateDebugger:aSelector
@@ -4186,8 +4193,14 @@
<resource: #skipInDebuggersWalkBack>
- ^ self error:'bad assign of ' , self printString ,
- ' (' , self class name , ') to integer-typed variable'
+"/ ^ self error:'bad assign of ' , self printString ,
+"/ ' (' , self class name , ') to integer-typed variable'
+ ^ InvalidTypeError
+ raiseRequestErrorString:(
+ 'bad assign of ' , self printString ,
+ ' (' , self class name , ') to integer-typed variable')
+
+ "Modified: / 02-11-2012 / 10:25:36 / cg"
!
invalidCodeObject
@@ -4197,19 +4210,23 @@
<resource: #skipInDebuggersWalkBack>
- self error:'not an executable code object'
-
- "Created: 1.8.1997 / 00:16:44 / cg"
+ "/ self error:'not an executable code object'
+ ^ ExecutionError
+ raiseRequestErrorString:'not an executable code object'
+
+ "Created: / 01-08-1997 / 00:16:44 / cg"
!
invalidMessage
"{ Pragma: +optSpace }"
- "this is sent by ST/V code - its the same as #shouldNotImplement"
+ "this is sent by ST/V code - it's the same as #shouldNotImplement"
<resource: #skipInDebuggersWalkBack>
^ self shouldNotImplement
+
+ "Modified (comment): / 02-11-2012 / 10:11:18 / cg"
!
mustBeRectangle
@@ -4219,7 +4236,11 @@
<resource: #skipInDebuggersWalkBack>
- ^ self error:'argument must be a Rectangle'
+ "/ ^ self error:'argument must be a Rectangle'
+ ^ InvalidTypeError
+ raiseRequestErrorString:'argument must be a Rectangle'
+
+ "Modified: / 02-11-2012 / 10:24:53 / cg"
!
mustBeString
@@ -4229,7 +4250,11 @@
<resource: #skipInDebuggersWalkBack>
- ^ self error:'argument must be a String'
+ "/ ^ self error:'argument must be a String'
+ ^ InvalidTypeError
+ raiseRequestErrorString:'argument must be a String'
+
+ "Modified: / 02-11-2012 / 10:24:35 / cg"
!
notIndexed
@@ -4242,7 +4267,7 @@
<resource: #skipInDebuggersWalkBack>
^ SubscriptOutOfBoundsError
- raiseErrorString:'receiver has no indexed variables'
+ raiseRequestErrorString:'receiver has no indexed variables'
"Modified: 26.7.1996 / 16:43:13 / cg"
!
@@ -4255,7 +4280,11 @@
<resource: #skipInDebuggersWalkBack>
- ^ self error:'method/functionality is not yet implemented'
+ "/ ^ self error:'method/functionality is not yet implemented'
+ ^ MethodNotAppropriateError
+ raiseRequestErrorString:'method/functionality is not yet implemented'
+
+ "Modified: / 02-11-2012 / 10:24:12 / cg"
!
openDebuggerOnException:ex
@@ -4473,8 +4502,10 @@
shouldNeverBeReached
"report an error that this point may never be reached."
- ^ self
- error:'Oops, this may never reached. Something somewhere was terribly wrong.'.
+ <resource: #skipInDebuggersWalkBack>
+
+ ^ ExecutionError
+ raiseRequestErrorString:'Oops, this may never reached. Something somewhere was terribly wrong.'.
"Modified: / 20-04-2005 / 18:59:28 / janfrog"
!
@@ -4482,9 +4513,14 @@
shouldNeverBeSent
"report an error that this message may never be sent to the reciever"
- ^ self error:'This message never may be sent to me!!'.
+ <resource: #skipInDebuggersWalkBack>
+
+ "/ ^ self error:'This message never may be sent to me!!'.
+ ^ MethodNotAppropriateError
+ raiseRequestErrorString:'This message never may be sent to me!!'
"Modified: / 20-04-2005 / 18:59:28 / janfrog"
+ "Modified: / 02-11-2012 / 10:10:42 / cg"
!
shouldNotImplement
@@ -4495,9 +4531,11 @@
<resource: #skipInDebuggersWalkBack>
- ^ self error:'method/functionality not appropriate for this class'
-
- "Modified: 8.5.1996 / 09:09:44 / cg"
+ "/ self error:'method/functionality not appropriate for this class'
+ ^ MethodNotAppropriateError
+ raiseRequestErrorString:'method/functionality not appropriate for this class'
+
+ "Modified: / 02-11-2012 / 10:02:25 / cg"
!
subclassResponsibility
@@ -4559,8 +4597,15 @@
<resource: #skipInDebuggersWalkBack>
- ^ self error:'bad assign of ' , self printString ,
- ' (' , self class name , ') to typed variable'
+"/ ^ self error:'bad assign of ' , self printString ,
+"/ ' (' , self class name , ') to typed variable'
+
+ ^ InvalidTypeError
+ raiseRequestErrorString:
+ ('bad assign of ' , self printString ,
+ ' (' , self class name , ') to typed variable')
+
+ "Modified: / 02-11-2012 / 10:19:15 / cg"
! !
!Object methodsFor:'evaluation'!
@@ -9511,11 +9556,11 @@
!Object class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.698 2012/09/30 15:33:40 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.703 2012/11/24 13:56:04 stefan Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic/Object.st,v 1.698 2012/09/30 15:33:40 stefan Exp §'
+ ^ '§Header: /cvs/stx/stx/libbasic/Object.st,v 1.703 2012/11/24 13:56:04 stefan Exp §'
!
version_SVN