#BUGFIX by cg
class: MessageTracer class
changed: #printObject:on:
class: MessageTracer::PrintingMessageTracer
added: #callLevelOf:
comment/format in: #output:
changed: #stepInterrupt
--- a/MessageTracer.st Sat Feb 01 16:00:53 2020 +0100
+++ b/MessageTracer.st Tue Feb 04 11:33:35 2020 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1994 by Claus Gittinger
All Rights Reserved
@@ -3932,10 +3934,16 @@
anObject isProtoObject ifTrue:[
s := anObject class nameWithArticle
] ifFalse:[
- s := anObject printString.
- s size > 40 ifTrue:[
- s := s contractTo:40.
- ].
+ Exception handle:[:ex |
+ "/ in case an error happens when we try to print an uninitialized object
+ "/ (eg. when tracing OrderedCollection new initContents)
+ s := anObject class nameWithArticle,'(**error in printString**)'
+ ] do:[
+ s := anObject printString.
+ s size > 40 ifTrue:[
+ s := s contractTo:40.
+ ].
+ ]
].
aStream nextPutAll:s
!
@@ -4167,22 +4175,42 @@
!MessageTracer::PrintingMessageTracer methodsFor:'accessing'!
-output:something
- output := something.
+output:aWriteStream
+ output := aWriteStream.
! !
!MessageTracer::PrintingMessageTracer methodsFor:'trace helpers'!
+callLevelOf:sender
+ "called for every send while tracing"
+
+ |level con rcvr|
+
+ level := 0.
+ con := sender.
+ [con notNil
+ and:[(rcvr := con receiver) ~~ self
+ and:[rcvr ~~ tracedBlock]]
+ ] whileFalse:[
+ con := con sender.
+ level := level + 1.
+ ].
+ ^ level
+!
+
stepInterrupt
"called for every send while tracing"
- |ignore sel con r outStream senderContext|
+ |ignore sel con r outStream senderContext level|
StepInterruptPending := nil.
con := senderContext := thisContext sender.
+
+ outStream := output notNil
+ ifTrue:[output]
+ ifFalse:[Processor activeProcess stderr].
+
ignore := false.
- outStream := output notNil ifTrue:[output] ifFalse:[Processor activeProcess stderr].
-
con receiver == Processor ifTrue:[
(sel := con selector) == #threadSwitch: ifTrue:[
ignore := true.
@@ -4201,34 +4229,15 @@
((r := con receiver) ~~ self
and:[r ~~ tracedBlock]) ifTrue:[
- traceDetail == #fullIndent ifTrue:[
- [con notNil
- and:[(r := con receiver) ~~ self
- and:[r ~~ tracedBlock]]] whileTrue:[
- ' ' printOn:outStream.
- con := con sender.
- ].
- con := senderContext.
- self class printFull:con on:outStream withSender:false.
+ ((traceDetail == #fullIndent) or:[traceDetail == #indent]) ifTrue:[
+ level := self callLevelOf:con.
+ outStream spaces:level.
+ ].
+ ((traceDetail == #fullIndent) or:[traceDetail == true]) ifTrue:[
+ self class printFull:senderContext on:outStream withSender:false.
] ifFalse:[
- traceDetail == #indent ifTrue:[
- [con notNil
- and:[(r := con receiver) ~~ self
- and:[r ~~ tracedBlock]]] whileTrue:[
- ' ' printOn:outStream.
- con := con sender.
- ].
- con := senderContext.
- con printOn:outStream.
- outStream cr.
- ] ifFalse:[
- traceDetail == true ifTrue:[
- self class printFull:con on:outStream withSender:true.
- ] ifFalse:[
- con printOn:outStream.
- outStream cr.
- ]
- ]
+ senderContext printOn:outStream.
+ outStream cr.
].
].
].