#BUGFIX by cg
authorClaus Gittinger <cg@exept.de>
Tue, 04 Feb 2020 11:33:35 +0100
changeset 4547 39478d06eadd
parent 4546 88e32ac10e79
child 4548 186c78af057e
#BUGFIX by cg class: MessageTracer class changed: #printObject:on: class: MessageTracer::PrintingMessageTracer added: #callLevelOf: comment/format in: #output: changed: #stepInterrupt
MessageTracer.st
--- 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.
             ].
         ].
     ].