Commit | Line | Data |
---|---|---|
0adfe95a LC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> | |
3 | ;;; | |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (test-services) | |
20 | #:use-module (gnu services) | |
0190c1c0 | 21 | #:use-module (gnu services shepherd) |
0adfe95a LC |
22 | #:use-module (srfi srfi-1) |
23 | #:use-module (srfi srfi-26) | |
24 | #:use-module (srfi srfi-34) | |
25 | #:use-module (srfi srfi-64)) | |
26 | ||
27 | (test-begin "services") | |
28 | ||
5152d13b LC |
29 | (test-assert "service-back-edges" |
30 | (let* ((t1 (service-type (name 't1) (extensions '()) | |
31 | (compose +) (extend *))) | |
32 | (t2 (service-type (name 't2) | |
33 | (extensions | |
34 | (list (service-extension t1 (const '())))) | |
35 | (compose +) (extend *))) | |
36 | (t3 (service-type (name 't3) | |
37 | (extensions | |
38 | (list (service-extension t2 identity) | |
39 | (service-extension t1 list))))) | |
40 | (s1 (service t1 #t)) | |
41 | (s2 (service t2 #t)) | |
42 | (s3 (service t3 #t)) | |
43 | (e (service-back-edges (list s1 s2 s3)))) | |
44 | (and (lset= eq? (e s1) (list s2 s3)) | |
45 | (lset= eq? (e s2) (list s3)) | |
46 | (null? (e s3))))) | |
47 | ||
0adfe95a LC |
48 | (test-equal "fold-services" |
49 | ;; Make sure 'fold-services' returns the right result. The numbers come | |
50 | ;; from services of type T3; 'xyz 60' comes from the service of type T2, | |
51 | ;; where 60 = 15 × 4 = (1 + 2 + 3 + 4 + 5) × 4. | |
52 | '(initial-value 5 4 3 2 1 xyz 60) | |
53 | (let* ((t1 (service-type (name 't1) (extensions '()) | |
54 | (compose concatenate) | |
55 | (extend cons))) | |
56 | (t2 (service-type (name 't2) | |
57 | (extensions | |
58 | (list (service-extension t1 | |
59 | (cut list 'xyz <>)))) | |
60 | (compose (cut reduce + 0 <>)) | |
61 | (extend *))) | |
62 | (t3 (service-type (name 't3) | |
63 | (extensions | |
64 | (list (service-extension t2 identity) | |
65 | (service-extension t1 list))))) | |
66 | (r (fold-services (cons* (service t1 'initial-value) | |
67 | (service t2 4) | |
68 | (map (lambda (x) | |
69 | (service t3 x)) | |
70 | (iota 5 1))) | |
71 | #:target-type t1))) | |
72 | (and (eq? (service-kind r) t1) | |
73 | (service-parameters r)))) | |
74 | ||
75 | (test-assert "fold-services, ambiguity" | |
76 | (let* ((t1 (service-type (name 't1) (extensions '()) | |
77 | (compose concatenate) | |
78 | (extend cons))) | |
79 | (t2 (service-type (name 't2) | |
80 | (extensions | |
81 | (list (service-extension t1 list))))) | |
82 | (s (service t2 42))) | |
83 | (guard (c ((ambiguous-target-service-error? c) | |
84 | (and (eq? (ambiguous-target-service-error-target-type c) | |
85 | t1) | |
86 | (eq? (ambiguous-target-service-error-service c) | |
87 | s)))) | |
88 | (fold-services (list (service t1 'first) | |
89 | (service t1 'second) | |
90 | s) | |
91 | #:target-type t1) | |
92 | #f))) | |
93 | ||
94 | (test-assert "fold-services, missing target" | |
95 | (let* ((t1 (service-type (name 't1) (extensions '()))) | |
96 | (t2 (service-type (name 't2) | |
97 | (extensions | |
98 | (list (service-extension t1 list))))) | |
99 | (s (service t2 42))) | |
100 | (guard (c ((missing-target-service-error? c) | |
101 | (and (eq? (missing-target-service-error-target-type c) | |
102 | t1) | |
103 | (eq? (missing-target-service-error-service c) | |
104 | s)))) | |
105 | (fold-services (list s) #:target-type t1) | |
106 | #f))) | |
107 | ||
d4053c71 AK |
108 | (test-assert "shepherd-service-back-edges" |
109 | (let* ((s1 (shepherd-service (provision '(s1)) (start #f))) | |
110 | (s2 (shepherd-service (provision '(s2)) | |
111 | (requirement '(s1)) | |
112 | (start #f))) | |
113 | (s3 (shepherd-service (provision '(s3)) | |
114 | (requirement '(s1 s2)) | |
115 | (start #f))) | |
116 | (e (shepherd-service-back-edges (list s1 s2 s3)))) | |
80a67734 LC |
117 | (and (lset= eq? (e s1) (list s2 s3)) |
118 | (lset= eq? (e s2) (list s3)) | |
119 | (null? (e s3))))) | |
120 | ||
0adfe95a LC |
121 | (test-end) |
122 | ||
123 | \f | |
124 | (exit (= (test-runner-fail-count (test-runner-current)) 0)) |