Commit | Line | Data |
---|---|---|
299112d3 | 1 | ;;; GNU Guix --- Functional package management for GNU |
fa99c4bb | 2 | ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 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) | |
8874faaa | 25 | #:use-module ((gnu packages) #:select (specification->package)) |
08d7e359 | 26 | #:use-module (guix tests) |
299112d3 | 27 | #:use-module (srfi srfi-1) |
5d7a8584 | 28 | #:use-module (srfi srfi-11) |
2cd09108 | 29 | #:use-module (srfi srfi-19) |
8874faaa | 30 | #:use-module (srfi srfi-26) |
5d7a8584 AK |
31 | #:use-module (srfi srfi-64) |
32 | #:use-module (ice-9 regex)) | |
299112d3 LC |
33 | |
34 | ;; Test the (guix ui) module. | |
35 | ||
36 | (define %paragraph | |
37 | "GNU Guile is an implementation of the Scheme programming language, with | |
38 | support for many SRFIs, packaged for use in a wide variety of environments. | |
39 | In addition to implementing the R5RS Scheme standard and a large subset of | |
40 | R6RS, Guile includes a module system, full access to POSIX system calls, | |
41 | networking support, multiple threads, dynamic linking, a foreign function call | |
42 | interface, and powerful string processing.") | |
43 | ||
5d7a8584 AK |
44 | (define guile-1.8.8 |
45 | (manifest-entry | |
46 | (name "guile") | |
47 | (version "1.8.8") | |
48 | (item "/gnu/store/...") | |
49 | (output "out"))) | |
50 | ||
51 | (define guile-2.0.9 | |
52 | (manifest-entry | |
53 | (name "guile") | |
54 | (version "2.0.9") | |
55 | (item "/gnu/store/...") | |
56 | (output "out"))) | |
57 | ||
299112d3 LC |
58 | \f |
59 | (test-begin "ui") | |
60 | ||
61 | (test-assert "fill-paragraph" | |
62 | (every (lambda (column) | |
63 | (every (lambda (width) | |
64 | (every (lambda (line) | |
65 | (<= (string-length line) width)) | |
66 | (string-split (fill-paragraph %paragraph | |
67 | width column) | |
68 | #\newline))) | |
69 | '(15 30 35 40 45 50 60 70 80 90 100))) | |
70 | '(0 5))) | |
71 | ||
72 | (test-assert "fill-paragraph, consecutive newlines" | |
73 | (every (lambda (width) | |
74 | (any (lambda (line) | |
75 | (string-prefix? "When STR" line)) | |
76 | (string-split | |
77 | (fill-paragraph (procedure-documentation fill-paragraph) | |
78 | width) | |
79 | #\newline))) | |
80 | '(15 20 25 30 40 50 60))) | |
81 | ||
82 | (test-equal "fill-paragraph, large unbreakable word" | |
83 | '("Here is a" "very-very-long-word" | |
84 | "and that's" "it.") | |
85 | (string-split | |
86 | (fill-paragraph "Here is a very-very-long-word and that's it." | |
87 | 10) | |
88 | #\newline)) | |
89 | ||
3a09e1d2 CS |
90 | (test-equal "fill-paragraph, two spaces after period" |
91 | "First line. Second line" | |
92 | (fill-paragraph "First line. | |
93 | Second line" 24)) | |
94 | ||
08d7e359 LC |
95 | (test-equal "package-description-string vs. Unicode" |
96 | "b•ll•t\n\n" ;see <http://bugs.gnu.org/21536> | |
97 | (with-fluids ((%default-port-encoding "ISO-8859-1")) | |
98 | (package-description-string | |
99 | (dummy-package "foo" (description "b•ll•t"))))) | |
100 | ||
2876b989 LC |
101 | (test-equal "package-specification->name+version+output" |
102 | '(("guile" #f "out") | |
103 | ("guile" "2.0.9" "out") | |
104 | ("guile" #f "debug") | |
105 | ("guile" "2.0.9" "debug") | |
106 | ("guile-cairo" "1.4.1" "out")) | |
107 | (map (lambda (spec) | |
108 | (call-with-values | |
109 | (lambda () | |
110 | (package-specification->name+version+output spec)) | |
111 | list)) | |
112 | '("guile" | |
1b846da8 | 113 | "guile@2.0.9" |
2876b989 | 114 | "guile:debug" |
1b846da8 ML |
115 | "guile@2.0.9:debug" |
116 | "guile-cairo@1.4.1"))) | |
2876b989 | 117 | |
2cd09108 NK |
118 | (test-equal "integer" |
119 | '(1) | |
120 | (string->generations "1")) | |
121 | ||
122 | (test-equal "comma-separated integers" | |
123 | '(3 7 1 4 6) | |
124 | (string->generations "3,7,1,4,6")) | |
125 | ||
126 | (test-equal "closed range" | |
127 | '(4 5 6 7 8 9 10 11 12) | |
128 | (string->generations "4..12")) | |
129 | ||
130 | (test-equal "closed range, equal endpoints" | |
131 | '(3) | |
132 | (string->generations "3..3")) | |
133 | ||
134 | (test-equal "indefinite end range" | |
135 | '(>= 7) | |
136 | (string->generations "7..")) | |
137 | ||
138 | (test-equal "indefinite start range" | |
139 | '(<= 42) | |
140 | (string->generations "..42")) | |
141 | ||
142 | (test-equal "integer, char" | |
143 | #f | |
144 | (string->generations "a")) | |
145 | ||
146 | (test-equal "comma-separated integers, consecutive comma" | |
147 | #f | |
148 | (string->generations "1,,2")) | |
149 | ||
150 | (test-equal "comma-separated integers, trailing comma" | |
151 | #f | |
152 | (string->generations "1,2,")) | |
153 | ||
154 | (test-equal "comma-separated integers, chars" | |
155 | #f | |
156 | (string->generations "a,b")) | |
157 | ||
158 | (test-equal "closed range, start > end" | |
159 | #f | |
160 | (string->generations "9..2")) | |
161 | ||
162 | (test-equal "closed range, chars" | |
163 | #f | |
164 | (string->generations "a..b")) | |
165 | ||
166 | (test-equal "indefinite end range, char" | |
167 | #f | |
168 | (string->generations "a..")) | |
169 | ||
170 | (test-equal "indefinite start range, char" | |
171 | #f | |
172 | (string->generations "..a")) | |
173 | ||
174 | (test-equal "duration, 1 day" | |
175 | (make-time time-duration 0 (* 3600 24)) | |
176 | (string->duration "1d")) | |
177 | ||
178 | (test-equal "duration, 1 week" | |
179 | (make-time time-duration 0 (* 3600 24 7)) | |
180 | (string->duration "1w")) | |
181 | ||
182 | (test-equal "duration, 1 month" | |
183 | (make-time time-duration 0 (* 3600 24 30)) | |
184 | (string->duration "1m")) | |
185 | ||
186 | (test-equal "duration, 1 week == 7 days" | |
187 | (string->duration "1w") | |
188 | (string->duration "7d")) | |
189 | ||
190 | (test-equal "duration, 1 month == 30 days" | |
191 | (string->duration "1m") | |
192 | (string->duration "30d")) | |
193 | ||
30d2397f LC |
194 | (test-equal "duration, 2 hours" |
195 | 7200 | |
196 | (time-second (string->duration "2h"))) | |
197 | ||
638c5b79 LC |
198 | (test-equal "duration, 1 second" |
199 | (make-time time-duration 0 1) | |
200 | (string->duration "1s")) | |
201 | ||
2cd09108 NK |
202 | (test-equal "duration, integer" |
203 | #f | |
204 | (string->duration "1")) | |
205 | ||
206 | (test-equal "duration, char" | |
207 | #f | |
208 | (string->duration "d")) | |
209 | ||
1d6243cf LC |
210 | (test-equal "size->number, bytes" |
211 | 42 | |
212 | (size->number "42")) | |
213 | ||
214 | (test-equal "size->number, MiB" | |
215 | (* 42 (expt 2 20)) | |
216 | (size->number "42MiB")) | |
217 | ||
218 | (test-equal "size->number, GiB" | |
219 | (* 3 (expt 2 30)) | |
220 | (size->number "3GiB")) | |
221 | ||
222 | (test-equal "size->number, 1.2GiB" | |
223 | (inexact->exact (round (* 1.2 (expt 2 30)))) | |
224 | (size->number "1.2GiB")) | |
225 | ||
4a44d7bb LC |
226 | (test-equal "size->number, 1T" |
227 | (expt 2 40) | |
228 | (size->number "1T")) | |
229 | ||
fa99c4bb LC |
230 | (test-equal "size->number, 1.M" |
231 | (expt 2 20) | |
232 | (size->number "1.M")) | |
233 | ||
1d6243cf LC |
234 | (test-assert "size->number, invalid unit" |
235 | (catch 'quit | |
236 | (lambda () | |
237 | (size->number "9X")) | |
238 | (lambda args | |
239 | #t))) | |
240 | ||
52ddf2ae LC |
241 | (test-equal "show-what-to-build, zero outputs" |
242 | "" | |
243 | (with-store store | |
244 | (let ((drv (derivation store "zero" "/bin/sh" '() | |
245 | #:outputs '()))) | |
246 | (with-error-to-string | |
247 | (lambda () | |
248 | ;; This should print nothing. | |
249 | (show-what-to-build store (list drv))))))) | |
250 | ||
5d7a8584 AK |
251 | (test-assert "show-manifest-transaction" |
252 | (let* ((m (manifest (list guile-1.8.8))) | |
253 | (t (manifest-transaction (install (list guile-2.0.9))))) | |
77ee4a96 | 254 | (with-store store |
c136da3f | 255 | (and (string-match "guile +1.8.8 → 2.0.9" |
77ee4a96 LC |
256 | (with-fluids ((%default-port-encoding "UTF-8")) |
257 | (with-error-to-string | |
258 | (lambda () | |
259 | (show-manifest-transaction store m t))))) | |
c136da3f | 260 | (string-match "guile +1.8.8 -> 2.0.9" |
1062063a LC |
261 | (with-error-to-string |
262 | (lambda () | |
263 | ;; In Guile 2.2, %DEFAULT-PORT-ENCODING doesn't | |
264 | ;; influence the encoding of string ports. | |
265 | (set-port-encoding! (current-error-port) | |
266 | "ISO-8859-1") | |
267 | (show-manifest-transaction store m t)))))))) | |
5d7a8584 | 268 | |
8874faaa LC |
269 | (test-assert "package-relevance" |
270 | (let ((guile (specification->package "guile")) | |
271 | (gcrypt (specification->package "guile-gcrypt")) | |
272 | (go (specification->package "go")) | |
273 | (gnugo (specification->package "gnugo")) | |
d2cdef65 | 274 | (libb2 (specification->package "libb2")) |
8874faaa LC |
275 | (rx (cut make-regexp <> regexp/icase)) |
276 | (>0 (cut > <> 0)) | |
277 | (=0 zero?)) | |
278 | (and (>0 (package-relevance guile | |
279 | (map rx '("scheme")))) | |
280 | (>0 (package-relevance guile | |
281 | (map rx '("scheme" "implementation")))) | |
282 | (>0 (package-relevance gcrypt | |
283 | (map rx '("guile" "crypto")))) | |
284 | (=0 (package-relevance guile | |
285 | (map rx '("guile" "crypto")))) | |
286 | (>0 (package-relevance go | |
287 | (map rx '("go")))) | |
288 | (=0 (package-relevance go | |
289 | (map rx '("go" "game")))) | |
290 | (>0 (package-relevance gnugo | |
d2cdef65 | 291 | (map rx '("go" "game")))) |
292 | (>0 (package-relevance libb2 | |
293 | (map rx '("crypto" "library"))))))) | |
8874faaa | 294 | |
299112d3 | 295 | (test-end "ui") |