mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 05:39:18 +02:00
adding (chibi log) tests
This commit is contained in:
parent
1f805fd3ae
commit
b0e5f70355
3 changed files with 53 additions and 1 deletions
41
lib/chibi/log-test.sld
Normal file
41
lib/chibi/log-test.sld
Normal file
|
@ -0,0 +1,41 @@
|
||||||
|
|
||||||
|
(define-library (chibi log-test)
|
||||||
|
(export run-tests)
|
||||||
|
(import (scheme base) (scheme inexact) (srfi 130)
|
||||||
|
(chibi log) (chibi show) (chibi test))
|
||||||
|
(begin
|
||||||
|
(define-syntax log->string
|
||||||
|
(syntax-rules ()
|
||||||
|
((log->string expr ...)
|
||||||
|
(let ((out (open-output-string)))
|
||||||
|
(parameterize ((current-error-port out))
|
||||||
|
(log-open default-logger)
|
||||||
|
expr ...
|
||||||
|
(get-output-string out))))))
|
||||||
|
(define-syntax log->string/no-dates
|
||||||
|
(syntax-rules ()
|
||||||
|
((log->string/no-dates expr ...)
|
||||||
|
(string-join
|
||||||
|
(map (lambda (line) (substring line 20))
|
||||||
|
(string-split (log->string expr ...) "\n"))
|
||||||
|
"\n"))))
|
||||||
|
(define (run-tests)
|
||||||
|
(test-begin "(chibi log)")
|
||||||
|
(test "D four: 4"
|
||||||
|
(log->string/no-dates
|
||||||
|
(log-debug "four: " (+ 2 2))))
|
||||||
|
(test "I pi: 3.14"
|
||||||
|
(log->string/no-dates
|
||||||
|
(log-info "pi: " (with ((precision 2)) (acos -1)))))
|
||||||
|
(test-assert
|
||||||
|
(string-prefix? "E "
|
||||||
|
(log->string/no-dates
|
||||||
|
(with-logged-errors (/ 1 0)))))
|
||||||
|
(test "W warn\nE error"
|
||||||
|
(log->string/no-dates
|
||||||
|
(with-log-level
|
||||||
|
'warn
|
||||||
|
(log-info "info")
|
||||||
|
(log-warn "warn")
|
||||||
|
(log-error "error"))))
|
||||||
|
(test-end))))
|
|
@ -24,6 +24,16 @@
|
||||||
(define (logger-current-level-set! logger level)
|
(define (logger-current-level-set! logger level)
|
||||||
(%logger-current-level-set! logger (log-level-index logger level)))
|
(%logger-current-level-set! logger (log-level-index logger level)))
|
||||||
|
|
||||||
|
(define-syntax with-log-level
|
||||||
|
(syntax-rules ()
|
||||||
|
((with-logger-level level expr0 expr1 ...)
|
||||||
|
(let* ((orig-level (logger-current-level default-logger))
|
||||||
|
(new-level (log-level-index default-logger level)))
|
||||||
|
(dynamic-wind
|
||||||
|
(lambda () (%logger-current-level-set! default-logger new-level))
|
||||||
|
(lambda () expr0 expr1 ...)
|
||||||
|
(lambda () (%logger-current-level-set! default-logger orig-level)))))))
|
||||||
|
|
||||||
(define-syntax define-logger
|
(define-syntax define-logger
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((define-logger logger (levels ...))
|
((define-logger logger (levels ...))
|
||||||
|
|
|
@ -20,7 +20,8 @@
|
||||||
log-level-index log-level-name log-level-abbrev
|
log-level-index log-level-name log-level-abbrev
|
||||||
;; the default logger
|
;; the default logger
|
||||||
default-logger log-emergency log-alert log-critical log-error
|
default-logger log-emergency log-alert log-critical log-error
|
||||||
log-warn log-notice log-info log-debug)
|
log-warn log-notice log-info log-debug
|
||||||
|
with-log-level)
|
||||||
(import (chibi time) (chibi string) (chibi show base))
|
(import (chibi time) (chibi string) (chibi show base))
|
||||||
(cond-expand
|
(cond-expand
|
||||||
(chibi
|
(chibi
|
||||||
|
|
Loading…
Add table
Reference in a new issue