From ca1a42e3e6fb9417c59575a0e5a36344537effb0 Mon Sep 17 00:00:00 2001
From: Oran Agra <oran@redislabs.com>
Date: Sun, 18 Apr 2021 11:55:54 +0300
Subject: [PATCH] Improve testsuite print of log file (#8805)

1. the `dump_logs` option would have printed only logs of servers that were
   spawn before the test proc started, and not ones that the test proc
   started inside it.
2. when a server proc catches an exception it should normally forward the
   exception upwards, specifically when it's an assertion that should be
   caught by a test proc above. however, in `durable` mode, we caught all
   exceptions printed them to stdout and let the code continue,
   this was wrong to do for assertions, which should have still been
   propagated to the test function.
3. don't bother to search for crash log to print if we printed the the
   entire log anyway
4. if no crash log was found, no need to print anything (i.e. the fact it
   wasn't found)
5. rename warnings_from_file to crashlog_from_file
---
 tests/support/server.tcl | 23 +++++++++++++++--------
 tests/support/test.tcl   |  2 ++
 tests/support/util.tcl   |  2 +-
 3 files changed, 18 insertions(+), 9 deletions(-)

diff --git a/tests/support/server.tcl b/tests/support/server.tcl
index 4c1bc37c8..e8fa3e6f2 100644
--- a/tests/support/server.tcl
+++ b/tests/support/server.tcl
@@ -508,6 +508,7 @@ proc start_server {options {code undefined}} {
         set num_tests $::num_tests
         if {[catch { uplevel 1 $code } error]} {
             set backtrace $::errorInfo
+            set assertion [string match "assertion:*" $error]
 
             # fetch srv back from the server list, in case it was restarted by restart_server (new PID)
             set srv [lindex $::servers end]
@@ -519,17 +520,23 @@ proc start_server {options {code undefined}} {
             dict set srv "skipleaks" 1
             kill_server $srv
 
-            # Print warnings from log
-            puts [format "\nLogged warnings (pid %d):" [dict get $srv "pid"]]
-            set warnings [warnings_from_file [dict get $srv "stdout"]]
-            if {[string length $warnings] > 0} {
-                puts "$warnings"
+            if {$::dump_logs && $assertion} {
+                # if we caught an assertion ($::num_failed isn't incremented yet)
+                # this happens when the test spawns a server and not the other way around
+                dump_server_log $srv
             } else {
-                puts "(none)"
+                # Print crash report from log
+                set crashlog [crashlog_from_file [dict get $srv "stdout"]]
+                if {[string length $crashlog] > 0} {
+                    puts [format "\nLogged crash report (pid %d):" [dict get $srv "pid"]]
+                    puts "$crashlog"
+                    puts ""
+                }
             }
-            puts ""
 
-            if {$::durable} {
+            if {!$assertion && $::durable} {
+                # durable is meant to prevent the whole tcl test from exiting on
+                # an exception. an assertion will be caught by the test proc.
                 set msg [string range $error 10 end]
                 lappend details $msg
                 lappend details $backtrace
diff --git a/tests/support/test.tcl b/tests/support/test.tcl
index 39aebe156..29d0cbf41 100644
--- a/tests/support/test.tcl
+++ b/tests/support/test.tcl
@@ -165,6 +165,8 @@ proc test {name code {okpattern undefined} {options undefined}} {
     if {[catch {set retval [uplevel 1 $code]} error]} {
         set assertion [string match "assertion:*" $error]
         if {$assertion || $::durable} {
+            # durable prevents the whole tcl test from exiting on an exception.
+            # an assertion is handled gracefully anyway.
             set msg [string range $error 10 end]
             lappend details $msg
             if {!$assertion} {
diff --git a/tests/support/util.tcl b/tests/support/util.tcl
index 5ea85c9e5..318cdf871 100644
--- a/tests/support/util.tcl
+++ b/tests/support/util.tcl
@@ -31,7 +31,7 @@ proc zlistAlikeSort {a b} {
 
 # Return all log lines starting with the first line that contains a warning.
 # Generally, this will be an assertion error with a stack trace.
-proc warnings_from_file {filename} {
+proc crashlog_from_file {filename} {
     set lines [split [exec cat $filename] "\n"]
     set matched 0
     set logall 0