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) | |
21 | #:use-module (srfi srfi-1) | |
22 | #:use-module (srfi srfi-26) | |
23 | #:use-module (srfi srfi-34) | |
24 | #:use-module (srfi srfi-64)) | |
25 | ||
26 | (test-begin "services") | |
27 | ||
28 | (test-equal "fold-services" | |
29 | ;; Make sure 'fold-services' returns the right result. The numbers come | |
30 | ;; from services of type T3; 'xyz 60' comes from the service of type T2, | |
31 | ;; where 60 = 15 × 4 = (1 + 2 + 3 + 4 + 5) × 4. | |
32 | '(initial-value 5 4 3 2 1 xyz 60) | |
33 | (let* ((t1 (service-type (name 't1) (extensions '()) | |
34 | (compose concatenate) | |
35 | (extend cons))) | |
36 | (t2 (service-type (name 't2) | |
37 | (extensions | |
38 | (list (service-extension t1 | |
39 | (cut list 'xyz <>)))) | |
40 | (compose (cut reduce + 0 <>)) | |
41 | (extend *))) | |
42 | (t3 (service-type (name 't3) | |
43 | (extensions | |
44 | (list (service-extension t2 identity) | |
45 | (service-extension t1 list))))) | |
46 | (r (fold-services (cons* (service t1 'initial-value) | |
47 | (service t2 4) | |
48 | (map (lambda (x) | |
49 | (service t3 x)) | |
50 | (iota 5 1))) | |
51 | #:target-type t1))) | |
52 | (and (eq? (service-kind r) t1) | |
53 | (service-parameters r)))) | |
54 | ||
55 | (test-assert "fold-services, ambiguity" | |
56 | (let* ((t1 (service-type (name 't1) (extensions '()) | |
57 | (compose concatenate) | |
58 | (extend cons))) | |
59 | (t2 (service-type (name 't2) | |
60 | (extensions | |
61 | (list (service-extension t1 list))))) | |
62 | (s (service t2 42))) | |
63 | (guard (c ((ambiguous-target-service-error? c) | |
64 | (and (eq? (ambiguous-target-service-error-target-type c) | |
65 | t1) | |
66 | (eq? (ambiguous-target-service-error-service c) | |
67 | s)))) | |
68 | (fold-services (list (service t1 'first) | |
69 | (service t1 'second) | |
70 | s) | |
71 | #:target-type t1) | |
72 | #f))) | |
73 | ||
74 | (test-assert "fold-services, missing target" | |
75 | (let* ((t1 (service-type (name 't1) (extensions '()))) | |
76 | (t2 (service-type (name 't2) | |
77 | (extensions | |
78 | (list (service-extension t1 list))))) | |
79 | (s (service t2 42))) | |
80 | (guard (c ((missing-target-service-error? c) | |
81 | (and (eq? (missing-target-service-error-target-type c) | |
82 | t1) | |
83 | (eq? (missing-target-service-error-service c) | |
84 | s)))) | |
85 | (fold-services (list s) #:target-type t1) | |
86 | #f))) | |
87 | ||
88 | (test-end) | |
89 | ||
90 | \f | |
91 | (exit (= (test-runner-fail-count (test-runner-current)) 0)) |