From e3cf2e3454a71c95f29d42e84908da906dab90a1 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Sat, 3 Oct 2020 08:26:36 +0200 Subject: 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 -- cgit v1.2.3