test/test-log.sgl — sigil-log

1;;; Tests for (sigil log)

3(import (sigil test)

4 (sigil log)

5 (sigil io)

6 (sigil string)

7 (sigil json)

8 (sigil dict))

10;; Helper: capture log output to a string

11(define (capture-log thunk)

12 (let ((port (open-output-string)))

13 (log-configure! target: port)

14 (thunk)

15 (get-output-string port)))

17;; Helper: reset to defaults before each group

18(define (reset-log!)

19 (log-configure! level: 'info format: 'text target: 'console))

21;; ============================================================

22;; Level Filtering

23;; ============================================================

25(test-group "level filtering"

26 (test "messages below current level are silent"

27 (reset-log!)

28 (log-configure! level: 'warn)

29 (let ((output (capture-log (lambda () (log-info "should not appear")))))

30 (assert-equal "" output)))

32 (test "messages at current level are emitted"

33 (reset-log!)

34 (log-configure! level: 'warn)

35 (let ((output (capture-log (lambda () (log-warn "visible")))))

36 (assert-true (string-contains? output "visible"))))

38 (test "messages above current level are emitted"

39 (reset-log!)

40 (log-configure! level: 'warn)

41 (let ((output (capture-log (lambda () (log-error "also visible")))))

42 (assert-true (string-contains? output "also visible")))))

44;; ============================================================

45;; Text Format

46;; ============================================================

48(test-group "text format"

49 (test "contains ISO 8601 timestamp"

50 (reset-log!)

51 (let ((output (capture-log (lambda () (log-info "test")))))

52 ;; Should contain a T and Z for UTC ISO 8601

53 (assert-true (string-contains? output "T"))

54 (assert-true (string-contains? output "Z"))))

56 (test "contains level tag"

57 (reset-log!)

58 (let ((output (capture-log (lambda () (log-info "test")))))

59 (assert-true (string-contains? output "[INFO]"))))

61 (test "contains message"

62 (reset-log!)

63 (let ((output (capture-log (lambda () (log-info "Server started")))))

64 (assert-true (string-contains? output "Server started"))))

66 (test "contains key=value fields"

67 (reset-log!)

68 (let ((output (capture-log (lambda () (log-info "started" port: 8080)))))

69 (assert-true (string-contains? output "port=8080")))))

71;; ============================================================

72;; JSON Format

73;; ============================================================

75(test-group "json format"

76 (test "produces valid JSON with expected keys"

77 (reset-log!)

78 (log-configure! format: 'json)

79 (let* ((output (capture-log (lambda () (log-info "hello" port: 8080))))

80 (parsed (json-decode (string-trim output))))

81 (assert-equal "info" (dict-ref parsed level:))

82 (assert-equal "hello" (dict-ref parsed message:))

83 (assert-equal 8080 (dict-ref parsed port:))

84 (assert-true (string-contains? (dict-ref parsed timestamp:) "T")))))

86;; ============================================================

87;; Incremental Configuration

88;; ============================================================

90(test-group "incremental configuration"

91 (test "changing level preserves format"

92 (reset-log!)

93 (log-configure! format: 'json)

94 (log-configure! level: 'debug)

95 ;; Format should still be json

96 (let* ((output (capture-log (lambda () (log-debug "test"))))

97 (parsed (json-decode (string-trim output))))

98 (assert-equal "debug" (dict-ref parsed level:))))

100 (test "changing format preserves level"

101 (reset-log!)

102 (log-configure! level: 'error)

103 (log-configure! format: 'text)

104 ;; Level should still be error — info should be silent

105 (let ((output (capture-log (lambda () (log-info "silent")))))

106 (assert-equal "" output))))

107

108;; ============================================================

109;; Custom Port Target

110;; ============================================================

111

112(test-group "custom port target"

113 (test "writes to configured port"

114 (reset-log!)

115 (let ((port (open-output-string)))

116 (log-configure! target: port)

117 (log-info "direct port test")

118 (let ((output (get-output-string port)))

119 (assert-true (string-contains? output "direct port test"))))))

120

121;; ============================================================

122;; All Six Levels

123;; ============================================================

124

125(test-group "all levels"

126 (test "trace level outputs TRACE tag"

127 (reset-log!)

128 (log-configure! level: 'trace)

129 (let ((output (capture-log (lambda () (log-trace "t")))))

130 (assert-true (string-contains? output "[TRACE]"))))

131

132 (test "debug level outputs DEBUG tag"

133 (reset-log!)

134 (log-configure! level: 'debug)

135 (let ((output (capture-log (lambda () (log-debug "d")))))

136 (assert-true (string-contains? output "[DEBUG]"))))

137

138 (test "info level outputs INFO tag"

139 (reset-log!)

140 (let ((output (capture-log (lambda () (log-info "i")))))

141 (assert-true (string-contains? output "[INFO]"))))

142

143 (test "warn level outputs WARN tag"

144 (reset-log!)

145 (let ((output (capture-log (lambda () (log-warn "w")))))

146 (assert-true (string-contains? output "[WARN]"))))

147

148 (test "error level outputs ERROR tag"

149 (reset-log!)

150 (let ((output (capture-log (lambda () (log-error "e")))))

151 (assert-true (string-contains? output "[ERROR]"))))

152

153 (test "fatal level outputs FATAL tag"

154 (reset-log!)

155 (let ((output (capture-log (lambda () (log-fatal "f")))))

156 (assert-true (string-contains? output "[FATAL]")))))

157

158;; ============================================================

159;; Lazy Macros

160;; ============================================================

161

162(test-group "lazy macros"

163 (test "lazy macro does not evaluate args when level inactive"

164 (reset-log!)

165 (log-configure! level: 'error)

166 (define evaluated #f)

167 (log-debug* "lazy" val: (begin (set! evaluated #t) 42))

168 (assert-false evaluated))

169

170 (test "lazy macro evaluates args when level active"

171 (reset-log!)

172 (log-configure! level: 'debug)

173 (define evaluated2 #f)

174 (let ((output (capture-log

175 (lambda ()

176 (log-debug* "lazy" val: (begin (set! evaluated2 #t) 42))))))

177 (assert-true evaluated2)

178 (assert-true (string-contains? output "lazy")))))

179

180;; ============================================================

181;; Utilities

182;; ============================================================

183

184(test-group "utilities"

185 (test "current-log-level returns symbol"

186 (reset-log!)

187 (assert-equal 'info (current-log-level)))

188

189 (test "current-log-level reflects configuration"

190 (reset-log!)

191 (log-configure! level: 'debug)

192 (assert-equal 'debug (current-log-level)))

193

194 (test "log-level-active? with symbol"

195 (reset-log!)

196 (assert-true (log-level-active? 'info))

197 (assert-true (log-level-active? 'error))

198 (assert-false (log-level-active? 'debug)))

199

200 (test "log-level-active? with number"

201 (reset-log!)

202 (assert-true (log-level-active? 2))

203 (assert-false (log-level-active? 1))))

204

205;; ============================================================

206;; Defensive formatting — logging must never propagate errors

207;; ============================================================

208;;

209;; A formatting failure inside emit-log (broken printer on a field

210;; value, clock quirk, port write failure, etc.) must NOT propagate

211;; out of the logger. A log call is a side effect; letting it

212;; escape has taken down whole MCP tool calls in the past.

213

214(test-group "emit-log never raises"

215 (test "logging to a closed port does not raise"

216 (reset-log!)

217 (let ((port (open-output-string)))

218 (close-output-port port)

219 (log-configure! target: port)

220 ;; If the guard in emit-log didn't swallow the write error,

221 ;; this call would raise and abort the test.

222 (log-info "after-close" key: "value")

223 (assert-true #t)))

224

225 (test "logging survives a value whose printer raises"

226 (reset-log!)

227 (let ((port (open-output-string)))

228 (log-configure! target: port)

229 ;; A cons-with-self cycle or a custom printer hook would be

230 ;; the natural trigger here. Since we can't easily install a

231 ;; printer that raises, simulate the class of failure by

232 ;; combining a broken target (closed) with a structured field.

233 (close-output-port port)

234 (log-info "broken" user: (list 1 2 3) trace: "abc")

235 (assert-true #t))))

236

237(run-tests)