[no subject]

[Mathieu Othacehe]

branch: master
commit e3cf2e3454a71c95f29d42e84908da906dab90a1
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Sat Oct 3 08:26:36 2020 +0200

    Print the caller name in timeout message.
    
    * src/cuirass/database.scm (with-db-worker-thread): Print the caller name.
---
 src/cuirass/database.scm | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 336c9c6..c904375 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -200,7 +200,9 @@ specified."
   "Evaluate EXP... in the critical section corresponding to %DB-CHANNEL.
 DB is bound to the argument of that critical section: the database
 connection."
-  (let ((timeout 5))
+  (let ((timeout 5)
+        (caller-name (frame-procedure-name
+                      (stack-ref (make-stack #t) 1))))
     (call-with-worker-thread
      (%db-channel)
      (lambda (db) exp ...)
@@ -208,8 +210,9 @@ connection."
      #:timeout-proc
      (lambda ()
        (log-message
-        (format #f "Database worker unresponsive for ~a seconds."
-                (number->string timeout)))))))
+        (format #f "Database worker unresponsive for ~a seconds (~a)."
+                (number->string timeout)
+                caller-name))))))
 
 (define-syntax-rule (with-db-registration-worker-thread db exp ...)
   "Similar to WITH-DB-WORKER-THREAD but evaluates EXP in database workers