AtlatestRepositorysigil-log

sigil-log / tree / test / uutmodule-arms.sgl

1;;; Per-module level filtering for (sigil log).
2;;;
3;;; This was DOCUMENTED and was a no-op: `log-configure! modules:` stored an
4;;; alist that nothing ever read, and no log call had any way to name a module.
5;;; The estate recorded that on 2026-08-11 and it still re-entered a task brief
6;;; on 2026-08-24, taken from the module's own docstring.
7;;;
8;;; The consequence that made it worth fixing rather than deleting: the Slate
9;;; node had to put terminal byte I/O at `trace` because the global level was
10;;; the only working volume control, so an operator who wants trace for ONE
11;;; subsystem gets every byte of every terminal.
12;;;
13;;; THE ARM THAT MATTERS IS "a module may be MORE verbose than the global
14;;; level", THROUGH A LAZY MACRO. Raising one subsystem is the whole feature,
15;;; the lazy macros are the recommended way to call, and a naive implementation
16;;; passes every other arm here while failing that one — because the lazy gate
17;;; runs before anything knows which module is being logged.
19(import (sigil test)
20 (sigil log)
21 (sigil io)
22 (sigil string))
24(define (capture thunk)
25 (let ((port (open-output-string)))
26 (log-configure! target: port)
27 (thunk)
28 (get-output-string port)))
30(define (reset!)
31 (log-configure! level: 'info format: 'text target: 'console modules: '()))
33;; ============================================================
34;; The feature is not a no-op
35;; ============================================================
37(test-group "per-module levels change behaviour at all"
38 (test "configuring a module below the global level suppresses its calls"
39 (reset!)
40 (log-configure! level: 'debug modules: '(("net" . error)))
41 (let ((out (capture (lambda () (log-debug "chatty" module: "net")))))
42 (assert-equal "" out)))
44 (test "the same call with no module configured is emitted"
45 (reset!)
46 (log-configure! level: 'debug)
47 (let ((out (capture (lambda () (log-debug "chatty" module: "net")))))
48 (assert-true (string-contains? out "chatty")))))
50;; ============================================================
51;; Raising ONE module above the global level — the Slate case
52;; ============================================================
54(test-group "a module may be more verbose than the global level"
55 (test "eager call: a raised module emits below the global level"
56 (reset!)
57 (log-configure! level: 'info modules: '(("node/tty" . trace)))
58 (let ((out (capture (lambda () (log-trace "byte in" module: "node/tty" n: 1)))))
59 (assert-true (string-contains? out "byte in"))))
61 (test "LAZY call: a raised module emits below the global level"
62 ;; The one that a naive implementation fails. `log-trace*` expands to a
63 ;; guard evaluated BEFORE the module is known, so that guard has to be
64 ;; permissive enough to let a raised module through.
65 (reset!)
66 (log-configure! level: 'info modules: '(("node/tty" . trace)))
67 (let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty" n: 1)))))
68 (assert-true (string-contains? out "byte in"))))
70 (test "raising one module does NOT raise the others"
71 (reset!)
72 (log-configure! level: 'info modules: '(("node/tty" . trace)))
73 (let ((out (capture (lambda () (log-trace* "session detail" module: "node/net")))))
74 (assert-equal "" out)))
76 (test "raising one module does NOT raise calls that name no module"
77 (reset!)
78 (log-configure! level: 'info modules: '(("node/tty" . trace)))
79 (let ((out (capture (lambda () (log-trace* "unattributed")))))
80 (assert-equal "" out))))
82;; ============================================================
83;; Fallback and shape
84;; ============================================================
86(test-group "per-module levels: fallback and shape"
87 (test "an unconfigured module falls back to the global level"
88 (reset!)
89 (log-configure! level: 'warn modules: '(("node/tty" . trace)))
90 (let ((out (capture (lambda () (log-info "ordinary" module: "node/net")))))
91 (assert-equal "" out))
92 (let ((out (capture (lambda () (log-error "bad" module: "node/net")))))
93 (assert-true (string-contains? out "bad"))))
95 (test "module names may be given as symbols in the config"
96 (reset!)
97 (log-configure! level: 'info modules: '((node/tty . trace)))
98 (let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty")))))
99 (assert-true (string-contains? out "byte in"))))
101 (test "the module: field is still emitted, so a line says where it came from"
102 (reset!)
103 (log-configure! level: 'info modules: '(("node/tty" . trace)))
104 (let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty")))))
105 (assert-true (string-contains? out "module=node/tty"))))
107 (test "clearing the module alist restores plain global filtering"
108 (reset!)
109 (log-configure! level: 'info modules: '(("node/tty" . trace)))
110 (log-configure! modules: '())
111 (let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty")))))
112 (assert-equal "" out))))
114;; ============================================================
115;; The two predicates
116;; ============================================================
118(test-group "level predicates"
119 (test "log-level-active? takes an optional module name"
120 (reset!)
121 (log-configure! level: 'info modules: '(("node/tty" . trace)))
122 (assert-true (log-level-active? 'trace "node/tty"))
123 (assert-false (log-level-active? 'trace "node/net"))
124 (assert-false (log-level-active? 'trace)))
126 (test "log-level-may-be-active? is permissive across modules"
127 ;; It must be TRUE wherever any real call would emit, or the lazy macro
128 ;; suppresses that call without ever evaluating its arguments.
129 (reset!)
130 (log-configure! level: 'info modules: '(("node/tty" . trace)))
131 (assert-true (log-level-may-be-active? 'trace))
132 (assert-false (log-level-active? 'trace)))
134 (test "with no modules configured the two predicates agree"
135 (reset!)
136 (log-configure! level: 'warn)
137 (assert-equal (log-level-active? 'info) (log-level-may-be-active? 'info))
138 (assert-equal (log-level-active? 'error) (log-level-may-be-active? 'error))))
140;; ============================================================
141;; The cost, stated rather than discovered
142;; ============================================================
144(test-group "laziness under per-module levels"
145 (test "with no modules configured, lazy args are not evaluated"
146 (reset!)
147 (log-configure! level: 'error)
148 (let ((ran #f))
149 (log-debug* "lazy" v: (begin (set! ran #t) 1))
150 (assert-false ran)))
152 (test "raising ANY module makes lazy args evaluate for that level everywhere"
153 ;; Honest cost of the conservative pre-filter, asserted so nobody
154 ;; discovers it in production. The call is still SUPPRESSED — only its
155 ;; argument expressions run.
156 (reset!)
157 (log-configure! level: 'error modules: '(("node/tty" . debug)))
158 (let ((ran #f))
159 (let ((out (capture (lambda ()
160 (log-debug* "lazy" module: "other"
161 v: (begin (set! ran #t) 1))))))
162 (assert-equal "" out)
163 (assert-true ran)))))
166;; ============================================================
167;; Robustness — found by adversarial review, 2026-08-25
168;; ============================================================
169;;
170;; The module feature must not make logging dangerous. Two regressions
171;; the first implementation introduced, both of which turn a logging
172;; concern into a caller's crash:
174(test-group "per-module levels must not make logging raise"
175 (test "a SUPPRESSED call with a malformed keyword list does not raise"
176 ;; The first implementation parsed the keyword list BEFORE the level
177 ;; check and outside emit-log's guard, so turning per-module levels
178 ;; on anywhere in the process made a previously inert suppressed call
179 ;; throw into its caller.
180 (reset!)
181 (log-configure! level: 'error modules: '(("z" . error)))
182 (log-debug "malformed" k:)
183 (assert-true #t))
185 (test "the same call with no modules configured does not raise"
186 (reset!)
187 (log-configure! level: 'error)
188 (log-debug "malformed" k:)
189 (assert-true #t))
191 (test "a malformed modules: alist does not raise out of log-configure!"
192 ;; A bad logging config must not take down the program it configures.
193 (reset!)
194 (log-configure! modules: '("not-a-pair"))
195 (log-configure! modules: '(("ok" . trace) "junk" ("also-ok" . error)))
196 (assert-true #t))
198 (test "malformed entries are skipped, valid ones still take effect"
199 (reset!)
200 (log-configure! level: 'info modules: '("junk" ("node/tty" . trace)))
201 (let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty")))))
202 (assert-true (string-contains? out "byte in"))))
204 (test "a non-list modules: value is ignored and leaves the alist alone"
205 (reset!)
206 (log-configure! level: 'info modules: '(("node/tty" . trace)))
207 (log-configure! modules: 'nope)
208 (let ((out (capture (lambda () (log-trace* "byte in" module: "node/tty")))))
209 (assert-true (string-contains? out "byte in")))))
211(run-tests)