From e3cf2e3454a71c95f29d42e84908da906dab90a1 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Sat, 3 Oct 2020 08:26:36 +0200
Subject: [PATCH] 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 336c9c6a..c9043754 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
--
GitLab