[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
From: |
Ludovic Courtès |
Date: |
Tue, 9 May 2023 10:28:17 -0400 (EDT) |
branch: master
commit f1f0489ed7f731d48e5bf1d152e79f33fa1410fe
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue May 9 14:42:03 2023 +0200
logging: Honor 'CUIRASS_LOGGING_LEVEL'.
* src/cuirass/logging.scm (current-logging-level): New variable.
(log-message): Honor it.
---
src/cuirass/logging.scm | 40 +++++++++++++++++++++++++++++-----------
1 file changed, 29 insertions(+), 11 deletions(-)
diff --git a/src/cuirass/logging.scm b/src/cuirass/logging.scm
index b7ce322..11a781e 100644
--- a/src/cuirass/logging.scm
+++ b/src/cuirass/logging.scm
@@ -57,20 +57,38 @@
;; timestamp.
(format (current-logging-port) "~a~%" str)))))
+(define current-logging-level
+ ;; Messages at this level and "above" this level are all logged; messages
+ ;; below this level are discarded.
+ (make-parameter (or (and=> (getenv "CUIRASS_LOGGING_LEVEL")
+ string->symbol)
+ 'info)
+ (lambda (value)
+ (unless (memq value '(debug info warning error))
+ (log-error "~s: invalid logging level~%" value)
+ (exit 1))
+ value)))
+
(define (log-message fmt level . args)
"Log the given message as one line."
;; Note: Use '@' to make sure -Wformat detects this use of 'format'.
- (let ((fmt (cond
- ((eq? level 'info)
- fmt)
- ((eq? level 'debug)
- (string-append "debug: " fmt))
- ((eq? level 'warning)
- (string-append "warning: " fmt))
- ((eq? level 'error)
- (string-append "error: " fmt)))))
- ((current-logging-procedure)
- (apply (@ (ice-9 format) format) #f fmt args))))
+ (when (or (and (eq? level 'debug)
+ (eq? (current-logging-level) 'debug))
+ (and (eq? level 'info)
+ (memq (current-logging-level) '(debug info)))
+ (and (eq? level 'warning)
+ (memq (current-logging-level) '(debug info warning))))
+ (let ((fmt (cond
+ ((eq? level 'info)
+ fmt)
+ ((eq? level 'debug)
+ (string-append "debug: " fmt))
+ ((eq? level 'warning)
+ (string-append "warning: " fmt))
+ ((eq? level 'error)
+ (string-append "error: " fmt)))))
+ ((current-logging-procedure)
+ (apply (@ (ice-9 format) format) #f fmt args)))))
(define-syntax-rule (log-info fmt args ...)
(log-message fmt 'info args ...))
- master updated (cf4e3e4 -> 70917db), Ludovic Courtès, 2023/05/09
- [no subject], Ludovic Courtès, 2023/05/09
- [no subject], Ludovic Courtès, 2023/05/09
- [no subject], Ludovic Courtès, 2023/05/09
- [no subject], Ludovic Courtès, 2023/05/09
- [no subject], Ludovic Courtès, 2023/05/09
- [no subject],
Ludovic Courtès <=
- [no subject], Ludovic Courtès, 2023/05/09
- [no subject], Ludovic Courtès, 2023/05/09
- [no subject], Ludovic Courtès, 2023/05/09
- [no subject], Ludovic Courtès, 2023/05/09
- [no subject], Ludovic Courtès, 2023/05/09
- [no subject], Ludovic Courtès, 2023/05/09
- [no subject], Ludovic Courtès, 2023/05/09
- [no subject], Ludovic Courtès, 2023/05/09
- [no subject], Ludovic Courtès, 2023/05/09