From: Will Budic <redacted>
Date: Mon, 10 Nov 2025 06:51:20 +0000 (+1100)
Subject: More pretty now stack trace.
X-Git-Url: https://lifelog.hopto.org/gitweb/?a=commitdiff_plain;h=a8b9e07b2fe1c70ab3b8618fa824a726d43f2cff;p=PerlCNF.git

More pretty now stack trace.
---

diff --git a/system/modules/TestManager.pm b/system/modules/TestManager.pm
index c5d2c15..546b694 100644
--- a/system/modules/TestManager.pm
+++ b/system/modules/TestManager.pm
@@ -34,12 +34,12 @@ sub new {
         $current_test_file = $test_file;
      }else{
         $current_test_file = "$CWD/$test_file"
-     }     
+     }
      return $self;
 }
 
 ###
-# Makes this test unsuited  to be skipped as part of an all test suit run. 
+# Makes this test unsuited  to be skipped as part of an all test suit run.
 # Usually called or set on a new test file that still needs further work and tests to be done to.
 # Also some experimental test files might be only,to be in direct run be only suitable.
 # By default all tests are suited with my $test = TestManager -> new($0);
@@ -69,7 +69,7 @@ sub passed {
 }
 
 sub case {
-    my ($self, $out, $ref) = @_;    
+    my ($self, $out, $ref) = @_;
     my ($package, $filename, $line) = caller; $filename =~ s/^(\/(.+)\/)//gs;
     exit 8 if not $self -> {suited} and $ENV{'RUNNING_IN_SUIT'};
     die "Case REF not in ordinal string format!\n For -> $CWD/$filename:$line\n" if $ref && $ref !~ m/\d*/g;
@@ -158,11 +158,11 @@ sub evaluate {
 # @return 1 on evaluation passed, 0 on failed.
 ###
 sub isDefined{
-    my ($self, $var, $val)=@_; 
+    my ($self, $var, $val)=@_;
     my ($package, $filename, $line) = caller;
     die qq( The expected parameters count required
             failed on TestManager->isDefined(\$var:"$var",\$val:"$val")!
-            \@Test -> $filename:$line  
+            \@Test -> $filename:$line
             )
         if @_ < 2;
     my $ref = ref($val);
@@ -258,26 +258,43 @@ sub dumpTermination {
         }
     }elsif($refT =~ /Exception/){
         my $trace = "";
-        my $i = 3;
+        my $i = 3; my $tc = scalar($comment->trace()->frames());
         foreach my $st($comment->trace()->frames()){
+            $tc--;
             if($trace){
-                $trace .= ' 'x$i .RED.$st->as_string()."\n";
+                my $str = $st->as_string();
+                $str =~ s/,\s+/,\n/g;
+                if($tc==0){
+                    my $caught = CYAN."caught at";
+                    $str =~ s/eval \{.+\} at/$caught/gs;
+                }else{
+                    if($tc==1){
+                        my $origin = "\n".CYAN."origin ->";
+                        $str =~ s/called at/$origin/gs;
+                        $trace .= '<'.'-'x$i .CYAN.$str."\n";
+                        next
+                    }else{
+                        my $tracing = "\n".RED."tracing ->";
+                        $str =~ s/called at/$tracing/gs;                        
+                    }
+                }
+                $trace .= '<'.'-'x$i .RED.$str.RESET."\n";
                 $i+=3;
             }else{
-                $trace = RED.$st->as_string()."\n";
-                $trace =~ s/called at/\n   thrown from \-\>/gs;
+                $trace = CYAN.$st->as_string()."\n";
+                $trace =~ s/called at/\nthrown from \-\>/gs;
                 ($file,$lnErr) =($st->filename(),$st->line())
             }
         }
         $comment = $message = $comment->{'message'}.$trace;
-        $comment =~ s/eval \{.+\} at/caught at/gs;
+
         #Old die methods could be present, caught by an Exception, manually having Error@{lno.} set.
         if($message =~ /^Error\@(\d+)/){
            $ErrAt = "\\\@$1";
         }else{
             my $error;
             ($error,$file,$lnErr) = ($message =~ m/(.*)\sat\s*(.*)\sline\s(\d*)\./)
-        }        
+        }
     }else{
         ($trace,$file,$lnErr) = ($comment =~ m/(.*)\sat\s*(.*)\sline\s(\d*)\.$/);
     }
@@ -293,9 +310,9 @@ sub dumpTermination {
         local $. = $i + 1;
         my $line = $slurp[$i];
         if($. >= $lnErr+1){
-           print $comment, RESET.frmln($.).$line;   
+           print $comment, RESET.frmln($.).$line;
            $file = "$CWD/$file" if $file !~ m/^$CWD/;
-           print "[".$file.":$i] Case  $failed->{test_cnt}\n\t".BRIGHT_RED."Failed\@Line".WHITE." $i -> ", 
+           print "[".$file.":$i] Case  $failed->{test_cnt}\n\t".BRIGHT_RED."Failed\@Line".WHITE." $i -> ",
                  $slurp[$i-1].RESET."Failed test file: $current_test_file";
            last
         }elsif($line=~m/^\s*(\#.*)/){