Commit | Line | Data |
---|---|---|
299112d3 | 1 | ;;; GNU Guix --- Functional package management for GNU |
77ee4a96 | 2 | ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> |
299112d3 LC |
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 | ||
20 | (define-module (test-ui) | |
21 | #:use-module (guix ui) | |
5d7a8584 | 22 | #:use-module (guix profiles) |
52ddf2ae LC |
23 | #:use-module (guix store) |
24 | #:use-module (guix derivations) | |
299112d3 | 25 | #:use-module (srfi srfi-1) |
5d7a8584 | 26 | #:use-module (srfi srfi-11) |
2cd09108 | 27 | #:use-module (srfi srfi-19) |
5d7a8584 AK |
28 | #:use-module (srfi srfi-64) |
29 | #:use-module (ice-9 regex)) | |
299112d3 LC |
30 | |
31 | ;; Test the (guix ui) module. | |
32 | ||
33 | (define %paragraph | |
34 | "GNU Guile is an implementation of the Scheme programming language, with | |
35 | support for many SRFIs, packaged for use in a wide variety of environments. | |
36 | In addition to implementing the R5RS Scheme standard and a large subset of | |
37 | R6RS, Guile includes a module system, full access to POSIX system calls, | |
38 | networking support, multiple threads, dynamic linking, a foreign function call | |
39 | interface, and powerful string processing.") | |
40 | ||
5d7a8584 AK |
41 | (define guile-1.8.8 |
42 | (manifest-entry | |
43 | (name "guile") | |
44 | (version "1.8.8") | |
45 | (item "/gnu/store/...") | |
46 | (output "out"))) | |
47 | ||
48 | (define guile-2.0.9 | |
49 | (manifest-entry | |
50 | (name "guile") | |
51 | (version "2.0.9") | |
52 | (item "/gnu/store/...") | |
53 | (output "out"))) | |
54 | ||
299112d3 LC |
55 | \f |
56 | (test-begin "ui") | |
57 | ||
58 | (test-assert "fill-paragraph" | |
59 | (every (lambda (column) | |
60 | (every (lambda (width) | |
61 | (every (lambda (line) | |
62 | (<= (string-length line) width)) | |
63 | (string-split (fill-paragraph %paragraph | |
64 | width column) | |
65 | #\newline))) | |
66 | '(15 30 35 40 45 50 60 70 80 90 100))) | |
67 | '(0 5))) | |
68 | ||
69 | (test-assert "fill-paragraph, consecutive newlines" | |
70 | (every (lambda (width) | |
71 | (any (lambda (line) | |
72 | (string-prefix? "When STR" line)) | |
73 | (string-split | |
74 | (fill-paragraph (procedure-documentation fill-paragraph) | |
75 | width) | |
76 | #\newline))) | |
77 | '(15 20 25 30 40 50 60))) | |
78 | ||
79 | (test-equal "fill-paragraph, large unbreakable word" | |
80 | '("Here is a" "very-very-long-word" | |
81 | "and that's" "it.") | |
82 | (string-split | |
83 | (fill-paragraph "Here is a very-very-long-word and that's it." | |
84 | 10) | |
85 | #\newline)) | |
86 | ||
3a09e1d2 CS |
87 | (test-equal "fill-paragraph, two spaces after period" |
88 | "First line. Second line" | |
89 | (fill-paragraph "First line. | |
90 | Second line" 24)) | |
91 | ||
2876b989 LC |
92 | (test-equal "package-specification->name+version+output" |
93 | '(("guile" #f "out") | |
94 | ("guile" "2.0.9" "out") | |
95 | ("guile" #f "debug") | |
96 | ("guile" "2.0.9" "debug") | |
97 | ("guile-cairo" "1.4.1" "out")) | |
98 | (map (lambda (spec) | |
99 | (call-with-values | |
100 | (lambda () | |
101 | (package-specification->name+version+output spec)) | |
102 | list)) | |
103 | '("guile" | |
104 | "guile-2.0.9" | |
105 | "guile:debug" | |
106 | "guile-2.0.9:debug" | |
107 | "guile-cairo-1.4.1"))) | |
108 | ||
2cd09108 NK |
109 | (test-equal "integer" |
110 | '(1) | |
111 | (string->generations "1")) | |
112 | ||
113 | (test-equal "comma-separated integers" | |
114 | '(3 7 1 4 6) | |
115 | (string->generations "3,7,1,4,6")) | |
116 | ||
117 | (test-equal "closed range" | |
118 | '(4 5 6 7 8 9 10 11 12) | |
119 | (string->generations "4..12")) | |
120 | ||
121 | (test-equal "closed range, equal endpoints" | |
122 | '(3) | |
123 | (string->generations "3..3")) | |
124 | ||
125 | (test-equal "indefinite end range" | |
126 | '(>= 7) | |
127 | (string->generations "7..")) | |
128 | ||
129 | (test-equal "indefinite start range" | |
130 | '(<= 42) | |
131 | (string->generations "..42")) | |
132 | ||
133 | (test-equal "integer, char" | |
134 | #f | |
135 | (string->generations "a")) | |
136 | ||
137 | (test-equal "comma-separated integers, consecutive comma" | |
138 | #f | |
139 | (string->generations "1,,2")) | |
140 | ||
141 | (test-equal "comma-separated integers, trailing comma" | |
142 | #f | |
143 | (string->generations "1,2,")) | |
144 | ||
145 | (test-equal "comma-separated integers, chars" | |
146 | #f | |
147 | (string->generations "a,b")) | |
148 | ||
149 | (test-equal "closed range, start > end" | |
150 | #f | |
151 | (string->generations "9..2")) | |
152 | ||
153 | (test-equal "closed range, chars" | |
154 | #f | |
155 | (string->generations "a..b")) | |
156 | ||
157 | (test-equal "indefinite end range, char" | |
158 | #f | |
159 | (string->generations "a..")) | |
160 | ||
161 | (test-equal "indefinite start range, char" | |
162 | #f | |
163 | (string->generations "..a")) | |
164 | ||
165 | (test-equal "duration, 1 day" | |
166 | (make-time time-duration 0 (* 3600 24)) | |
167 | (string->duration "1d")) | |
168 | ||
169 | (test-equal "duration, 1 week" | |
170 | (make-time time-duration 0 (* 3600 24 7)) | |
171 | (string->duration "1w")) | |
172 | ||
173 | (test-equal "duration, 1 month" | |
174 | (make-time time-duration 0 (* 3600 24 30)) | |
175 | (string->duration "1m")) | |
176 | ||
177 | (test-equal "duration, 1 week == 7 days" | |
178 | (string->duration "1w") | |
179 | (string->duration "7d")) | |
180 | ||
181 | (test-equal "duration, 1 month == 30 days" | |
182 | (string->duration "1m") | |
183 | (string->duration "30d")) | |
184 | ||
185 | (test-equal "duration, integer" | |
186 | #f | |
187 | (string->duration "1")) | |
188 | ||
189 | (test-equal "duration, char" | |
190 | #f | |
191 | (string->duration "d")) | |
192 | ||
1d6243cf LC |
193 | (test-equal "size->number, bytes" |
194 | 42 | |
195 | (size->number "42")) | |
196 | ||
197 | (test-equal "size->number, MiB" | |
198 | (* 42 (expt 2 20)) | |
199 | (size->number "42MiB")) | |
200 | ||
201 | (test-equal "size->number, GiB" | |
202 | (* 3 (expt 2 30)) | |
203 | (size->number "3GiB")) | |
204 | ||
205 | (test-equal "size->number, 1.2GiB" | |
206 | (inexact->exact (round (* 1.2 (expt 2 30)))) | |
207 | (size->number "1.2GiB")) | |
208 | ||
4a44d7bb LC |
209 | (test-equal "size->number, 1T" |
210 | (expt 2 40) | |
211 | (size->number "1T")) | |
212 | ||
1d6243cf LC |
213 | (test-assert "size->number, invalid unit" |
214 | (catch 'quit | |
215 | (lambda () | |
216 | (size->number "9X")) | |
217 | (lambda args | |
218 | #t))) | |
219 | ||
52ddf2ae LC |
220 | (test-equal "show-what-to-build, zero outputs" |
221 | "" | |
222 | (with-store store | |
223 | (let ((drv (derivation store "zero" "/bin/sh" '() | |
224 | #:outputs '()))) | |
225 | (with-error-to-string | |
226 | (lambda () | |
227 | ;; This should print nothing. | |
228 | (show-what-to-build store (list drv))))))) | |
229 | ||
5d7a8584 AK |
230 | (test-assert "show-manifest-transaction" |
231 | (let* ((m (manifest (list guile-1.8.8))) | |
232 | (t (manifest-transaction (install (list guile-2.0.9))))) | |
77ee4a96 LC |
233 | (with-store store |
234 | (and (string-match "guile\t1.8.8 → 2.0.9" | |
235 | (with-fluids ((%default-port-encoding "UTF-8")) | |
236 | (with-error-to-string | |
237 | (lambda () | |
238 | (show-manifest-transaction store m t))))) | |
239 | (string-match "guile\t1.8.8 -> 2.0.9" | |
240 | (with-fluids ((%default-port-encoding "ISO-8859-1")) | |
241 | (with-error-to-string | |
242 | (lambda () | |
243 | (show-manifest-transaction store m t))))))))) | |
5d7a8584 | 244 | |
299112d3 LC |
245 | (test-end "ui") |
246 | ||
247 | \f | |
248 | (exit (= (test-runner-fail-count (test-runner-current)) 0)) |