projects/guix·blob python-team · refs

500 lines · 14.0 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2021, 2022 Maxim Cournoyer <[email protected]>
3;;; Copyright © 2021 Xinglu Chen <[email protected]>
4;;; Copyright © 2022 Ludovic Courtès <[email protected]>
5;;; Copyright © 2023 Bruno Victal <[email protected]>
6;;; Copyright © 2026 Giacomo Leidi <[email protected]>
7;;;
8;;; This file is part of GNU Guix.
9;;;
10;;; GNU Guix is free software; you can redistribute it and/or modify it
11;;; under the terms of the GNU General Public License as published by
12;;; the Free Software Foundation; either version 3 of the License, or (at
13;;; your option) any later version.
14;;;
15;;; GNU Guix is distributed in the hope that it will be useful, but
16;;; WITHOUT ANY WARRANTY; without even the implied warranty of
17;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18;;; GNU General Public License for more details.
19;;;
20;;; You should have received a copy of the GNU General Public License
21;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
22
23(define-module (tests services configuration)
24 #:use-module (gnu services configuration)
25 #:use-module (gnu services configuration environment-variables)
26 #:use-module (guix diagnostics)
27 #:use-module (guix gexp)
28 #:autoload (guix i18n) (G_)
29 #:use-module (srfi srfi-34)
30 #:use-module (srfi srfi-64))
31
32;;; Tests for the (gnu services configuration) module.
33
34(test-begin "services-configuration")
35
36(define (serialize-number field value)
37 (format #f "~a=~a" field value))
38
39
40;;;
41;;; define-configuration macro.
42;;;
43
44(define-configuration port-configuration
45 (port (number 80) "The port number.")
46 (no-serialization))
47
48(test-equal "default value, no serialization"
49 80
50 (port-configuration-port (port-configuration)))
51
52(test-equal "wrong type for a field"
53 '("configuration.scm" 61 11) ;error location
54 (guard (c ((configuration-error? c)
55 (let ((loc (error-location c)))
56 (list (basename (location-file loc))
57 (location-line loc)
58 (location-column loc)))))
59 (port-configuration
60 ;; This is line 60; the test relies on line/column numbers!
61 (port "This is not a number!"))))
62
63(test-equal "field value evaluated once"
64 '(1 80)
65 (let ((evaluations 0))
66 (let ((configuration
67 (port-configuration
68 (port (begin
69 (set! evaluations (1+ evaluations))
70 80)))))
71 (list evaluations (port-configuration-port configuration)))))
72
73(define-configuration port-configuration-cs
74 (port (number 80) "The port number." empty-serializer))
75
76(test-equal "default value, custom serializer"
77 80
78 (port-configuration-cs-port (port-configuration-cs)))
79
80(define-configuration port-configuration-ndv
81 (port (number) "The port number."))
82
83(test-equal "no default value, provided"
84 55
85 (port-configuration-ndv-port (port-configuration-ndv
86 (port 55))))
87
88(test-assert "no default value, not provided"
89 (guard (c ((configuration-error? c)
90 #t))
91 (port-configuration-ndv-port (port-configuration-ndv))))
92
93(define (custom-number-serializer name value)
94 (format #f "~a = ~a;" name value))
95
96(define-configuration serializable-configuration
97 (port (number 80) "The port number." (serializer custom-number-serializer)))
98
99(define-configuration serializable-configuration-deprecated
100 (port (number 80) "The port number." custom-number-serializer))
101
102(test-assert "serialize-configuration"
103 (gexp?
104 (let ((config (serializable-configuration)))
105 (serialize-configuration config serializable-configuration-fields))))
106
107(test-assert "serialize-configuration [deprecated]"
108 (gexp?
109 (let ((config (serializable-configuration-deprecated)))
110 (serialize-configuration
111 config serializable-configuration-deprecated-fields))))
112
113(define-configuration serializable-configuration
114 (port (number 80) "The port number." (serializer custom-number-serializer))
115 (no-serialization))
116
117(test-assert "serialize-configuration with no-serialization"
118 ;; When serialization is disabled, the serializer is set to #f, so
119 ;; attempting to use it fails with a 'wrong-type-arg' error.
120 (not (false-if-exception
121 (let ((config (serializable-configuration)))
122 (serialize-configuration config serializable-configuration-fields)))))
123
124(define (custom-prefix-serialize-integer field-name name) name)
125
126(define-configuration configuration-with-prefix
127 (port (integer 10) "The port number.")
128 (prefix custom-prefix-))
129
130(test-assert "serialize-configuration with prefix"
131 (gexp?
132 (let ((config (configuration-with-prefix)))
133 (serialize-configuration config configuration-with-prefix-fields))))
134
135
136;;;
137;;; define-configuration macro, extra-args literals
138;;;
139
140(define (eval-gexp x)
141 "Get serialized config as string."
142 (eval (gexp->approximate-sexp x)
143 (current-module)))
144
145(define (port? value)
146 (or (string? value) (number? value)))
147
148(define (sanitize-port value)
149 (cond ((number? value) value)
150 ((string? value) (string->number value))
151 (else (raise (formatted-message (G_ "Bad value: ~a") value)))))
152
153(test-group "Basic sanitizer literal tests"
154 (define serialize-port serialize-number)
155
156 (define-configuration config-with-sanitizer
157 (port
158 (port 80)
159 "Lorem Ipsum."
160 (sanitizer sanitize-port)))
161
162 (test-equal "default value, sanitizer"
163 80
164 (config-with-sanitizer-port (config-with-sanitizer)))
165
166 (test-equal "string value, sanitized to number"
167 56
168 (config-with-sanitizer-port (config-with-sanitizer
169 (port "56"))))
170
171 (define (custom-serialize-port field-name value)
172 (number->string value))
173
174 (define-configuration config-serializer
175 (port
176 (port 80)
177 "Lorem Ipsum."
178 (serializer custom-serialize-port)))
179
180 (test-equal "default value, serializer literal"
181 "80"
182 (eval-gexp
183 (serialize-configuration (config-serializer)
184 config-serializer-fields))))
185
186(test-group "empty-serializer as literal/procedure tests"
187 (define-configuration config-with-literal
188 (port
189 (port 80)
190 "Lorem Ipsum."
191 empty-serializer))
192
193 (define-configuration config-with-proc
194 (port
195 (port 80)
196 "Lorem Ipsum."
197 (serializer empty-serializer)))
198
199 (test-equal "empty-serializer as literal"
200 ""
201 (eval-gexp
202 (serialize-configuration (config-with-literal)
203 config-with-literal-fields)))
204
205 (test-equal "empty-serializer as procedure"
206 ""
207 (eval-gexp
208 (serialize-configuration (config-with-proc)
209 config-with-proc-fields))))
210
211(test-group "permutation tests"
212 (define-configuration config-san+empty-ser
213 (port
214 (port 80)
215 "Lorem Ipsum."
216 (sanitizer sanitize-port)
217 empty-serializer))
218
219 (define-configuration config-san+ser
220 (port
221 (port 80)
222 "Lorem Ipsum."
223 (sanitizer sanitize-port)
224 (serializer (lambda _ "foo"))))
225
226 (test-equal "default value, sanitizer, permutation"
227 80
228 (config-san+empty-ser-port (config-san+empty-ser)))
229
230 (test-equal "default value, serializer, permutation"
231 "foo"
232 (eval-gexp
233 (serialize-configuration (config-san+ser) config-san+ser-fields)))
234
235 (test-equal "string value sanitized to number, permutation"
236 56
237 (config-san+ser-port (config-san+ser
238 (port "56"))))
239
240 ;; Ordering tests.
241 (define-configuration config-ser+san
242 (port
243 (port 80)
244 "Lorem Ipsum."
245 (sanitizer sanitize-port)
246 (serializer (lambda _ "foo"))))
247
248 (define-configuration config-empty-ser+san
249 (port
250 (port 80)
251 "Lorem Ipsum."
252 empty-serializer
253 (sanitizer sanitize-port)))
254
255 (test-equal "default value, sanitizer, permutation 2"
256 56
257 (config-empty-ser+san-port (config-empty-ser+san
258 (port "56"))))
259
260 (test-equal "default value, serializer, permutation 2"
261 "foo"
262 (eval-gexp
263 (serialize-configuration (config-ser+san) config-ser+san-fields))))
264
265(test-group "duplicated/conflicting entries"
266 (test-error
267 "duplicate sanitizer" #t
268 (macroexpand '(define-configuration dupe-san
269 (foo
270 (list '())
271 "Lorem Ipsum."
272 (sanitizer (lambda () #t))
273 (sanitizer (lambda () #t))))))
274
275 (test-error
276 "duplicate serializer" #t
277 (macroexpand '(define-configuration dupe-ser
278 (foo
279 (list '())
280 "Lorem Ipsum."
281 (serializer (lambda _ ""))
282 (serializer (lambda _ ""))))))
283
284 (test-error
285 "conflicting use of serializer + empty-serializer" #t
286 (macroexpand '(define-configuration ser+empty-ser
287 (foo
288 (list '())
289 "Lorem Ipsum."
290 (serializer (lambda _ "lorem"))
291 empty-serializer)))))
292
293(test-group "Mix of deprecated and new syntax"
294 (test-error
295 "Mix of bare serializer and new syntax" #t
296 (macroexpand '(define-configuration mixed
297 (foo
298 (list '())
299 "Lorem Ipsum."
300 (sanitizer (lambda () #t))
301 (lambda _ "lorem")))))
302
303 (test-error
304 "Mix of bare serializer and new syntax, permutation)" #t
305 (macroexpand '(define-configuration mixed
306 (foo
307 (list '())
308 "Lorem Ipsum."
309 (lambda _ "lorem")
310 (sanitizer (lambda () #t)))))))
311
312
313;;;
314;;; define-maybe macro.
315;;;
316(define-maybe number)
317
318(define-configuration config-with-maybe-number
319 (port (maybe-number 80) "")
320 (count maybe-number ""))
321
322(test-equal "maybe value serialization"
323 "port=80"
324 (serialize-maybe-number "port" 80))
325
326(define (config-with-maybe-number->string x)
327 (eval (gexp->approximate-sexp
328 (serialize-configuration x config-with-maybe-number-fields))
329 (current-module)))
330
331(test-equal "maybe value serialization of the instance"
332 "port=42count=43"
333 (config-with-maybe-number->string
334 (config-with-maybe-number
335 (port 42)
336 (count 43))))
337
338(test-equal "maybe value serialization of the instance, unspecified"
339 "port=42"
340 (config-with-maybe-number->string
341 (config-with-maybe-number
342 (port 42))))
343
344(define (serialize-symbol name value)
345 (format #f "~a=~a~%" name value))
346
347(define-maybe symbol)
348
349(define-configuration config-with-maybe-symbol
350 (protocol maybe-symbol ""))
351
352(test-equal "symbol maybe value serialization, unspecified"
353 ""
354 (eval-gexp
355 (serialize-configuration (config-with-maybe-symbol)
356 config-with-maybe-symbol-fields)))
357
358(define-maybe/no-serialization string)
359
360(define-configuration config-with-maybe-string/no-serialization
361 (name (maybe-string) "The name of the item.")
362 (no-serialization))
363
364(test-assert "maybe value without serialization no procedure bound"
365 (not (defined? 'serialize-maybe-string)))
366
367(test-assert "maybe type, no default"
368 (eq? %unset-value
369 (config-with-maybe-string/no-serialization-name
370 (config-with-maybe-string/no-serialization))))
371
372(test-assert "maybe type, with default"
373 (equal?
374 "foo"
375 (config-with-maybe-string/no-serialization-name
376 (config-with-maybe-string/no-serialization
377 (name "foo")))))
378
379
380;;;
381;;; environment-variables serializer
382;;;
383
384(define-configuration/no-serialization env-config
385 (port (number 80) "")
386 (count maybe-number "")
387 (name string "")
388 (url maybe-string "")
389 (active? (boolean #f) ""))
390
391(test-group "environment variables serializer"
392
393 (test-equal "basic serialization"
394 '(("PORT" . "70")
395 ("COUNT" . "80")
396 ("NAME" . "Hello World")
397 ("URL" . "https://example.org")
398 ("ACTIVE" . "true"))
399 (serialize-environment-variables
400 (env-config
401 (port 70)
402 (name "Hello World")
403 (url "https://example.org")
404 (active? #t)
405 (count 80))
406 env-config-fields))
407
408 (test-equal "field selection"
409 '(("PORT" . "80"))
410 (serialize-environment-variables
411 (env-config
412 (name "Hello World"))
413 env-config-fields
414 '(port)))
415
416 (test-equal "field negative selection"
417 '(("NAME" . "Hello World")
418 ("ACTIVE" . "false"))
419 (serialize-environment-variables
420 (env-config
421 (name "Hello World"))
422 env-config-fields
423 '(port)
424 #t))
425
426 (test-equal "variable prefixes"
427 '(("TEST_PORT" . "80")
428 ("TEST_NAME" . "Hello World")
429 ("TEST_ACTIVE" . "false"))
430 (serialize-environment-variables
431 (env-config
432 (name "Hello World"))
433 env-config-fields
434 #:prefix "TEST_"))
435
436 (test-equal "boolean serialization"
437 '(("PORT" . "80")
438 ("NAME" . "Hello World")
439 ("ACTIVE" . "1"))
440 (serialize-environment-variables
441 (env-config
442 (name "Hello World")
443 (active? #t))
444 env-config-fields
445 #:true-value "1"
446 #:false-value "0"))
447
448 (test-equal "full record serialization"
449 '(("TEST_COUNT" . "800")
450 ("TEST_NAME" . "Hello World")
451 ("TEST_URL" . "https://example.org")
452 ("TEST_ACTIVE" . "1"))
453 (serialize-environment-variables
454 (env-config
455 (port 90)
456 (name "Hello World")
457 (count 800)
458 (url "https://example.org")
459 (active? #t))
460 env-config-fields
461 '(port)
462 #t
463 #:prefix "TEST_"
464 #:true-value "1"
465 #:false-value "0")))
466
467(define-configuration another-env-config
468 (port
469 (number 80)
470 ""
471 (serializer serialize-number-environment-variable))
472 (count
473 (maybe-number)
474 ""
475 (serializer serialize-maybe-number-environment-variable))
476 (name
477 (string)
478 ""
479 (serializer serialize-string-environment-variable))
480 (url
481 (maybe-string)
482 ""
483 (serializer serialize-maybe-string-environment-variable))
484 (active?
485 (boolean #f)
486 ""
487 (serializer serialize-boolean-environment-variable)))
488
489(test-group "environment variables serializer, with field serializers"
490
491 (test-assert "full record serialization"
492 (gexp?
493 (serialize-configuration
494 (another-env-config
495 (port 90)
496 (name "Hello World")
497 (count 800)
498 (url "https://example.org")
499 (active? #t))
500 another-env-config-fields))))