diff options
| author | Mathieu Othacehe <othacehe@gnu.org> | 2020-10-03 08:26:36 +0200 |
|---|---|---|
| committer | Mathieu Othacehe <othacehe@gnu.org> | 2020-10-03 08:26:36 +0200 |
| commit | e3cf2e3454a71c95f29d42e84908da906dab90a1 (patch) | |
| tree | c47dad771ea5121b33b464b7524ec5e63dd37916 | |
| parent | 91de9bbc5a2d7b1d7732ffe6b9cc49874a923f50 (diff) | |
| download | cuirass-e3cf2e3454a71c95f29d42e84908da906dab90a1.tar cuirass-e3cf2e3454a71c95f29d42e84908da906dab90a1.tar.gz | |
Print the caller name in timeout message.
* src/cuirass/database.scm (with-db-worker-thread): Print the caller name.
| -rw-r--r-- | src/cuirass/database.scm | 9 |
1 files 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 |