Commit | Line | Data |
---|---|---|
299112d3 | 1 | ;;; GNU Guix --- Functional package management for GNU |
bbcd06e5 | 2 | ;;; Copyright © 2013-2017, 2019-2020, 2022 Ludovic Courtès <ludo@gnu.org> |
c8803d89 | 3 | ;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info> |
299112d3 LC |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
8 | ;;; under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
10 | ;;; your option) any later version. | |
11 | ;;; | |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ;;; | |
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | ||
21 | (define-module (test-ui) | |
22 | #:use-module (guix ui) | |
5d7a8584 | 23 | #:use-module (guix profiles) |
52ddf2ae LC |
24 | #:use-module (guix store) |
25 | #:use-module (guix derivations) | |
8874faaa | 26 | #:use-module ((gnu packages) #:select (specification->package)) |
08d7e359 | 27 | #:use-module (guix tests) |
c8803d89 | 28 | #:use-module (guix utils) |
299112d3 | 29 | #:use-module (srfi srfi-1) |
5d7a8584 | 30 | #:use-module (srfi srfi-11) |
2cd09108 | 31 | #:use-module (srfi srfi-19) |
8874faaa | 32 | #:use-module (srfi srfi-26) |
5d7a8584 AK |
33 | #:use-module (srfi srfi-64) |
34 | #:use-module (ice-9 regex)) | |
299112d3 LC |
35 | |
36 | ;; Test the (guix ui) module. | |
37 | ||
38 | (define %paragraph | |
39 | "GNU Guile is an implementation of the Scheme programming language, with | |
40 | support for many SRFIs, packaged for use in a wide variety of environments. | |
41 | In addition to implementing the R5RS Scheme standard and a large subset of | |
42 | R6RS, Guile includes a module system, full access to POSIX system calls, | |
43 | networking support, multiple threads, dynamic linking, a foreign function call | |
44 | interface, and powerful string processing.") | |
45 | ||
5d7a8584 AK |
46 | (define guile-1.8.8 |
47 | (manifest-entry | |
48 | (name "guile") | |
49 | (version "1.8.8") | |
50 | (item "/gnu/store/...") | |
51 | (output "out"))) | |
52 | ||
53 | (define guile-2.0.9 | |
54 | (manifest-entry | |
55 | (name "guile") | |
56 | (version "2.0.9") | |
57 | (item "/gnu/store/...") | |
58 | (output "out"))) | |
59 | ||
299112d3 LC |
60 | \f |
61 | (test-begin "ui") | |
62 | ||
63 | (test-assert "fill-paragraph" | |
64 | (every (lambda (column) | |
65 | (every (lambda (width) | |
66 | (every (lambda (line) | |
67 | (<= (string-length line) width)) | |
68 | (string-split (fill-paragraph %paragraph | |
69 | width column) | |
70 | #\newline))) | |
71 | '(15 30 35 40 45 50 60 70 80 90 100))) | |
72 | '(0 5))) | |
73 | ||
74 | (test-assert "fill-paragraph, consecutive newlines" | |
75 | (every (lambda (width) | |
76 | (any (lambda (line) | |
77 | (string-prefix? "When STR" line)) | |
78 | (string-split | |
79 | (fill-paragraph (procedure-documentation fill-paragraph) | |
80 | width) | |
81 | #\newline))) | |
82 | '(15 20 25 30 40 50 60))) | |
83 | ||
84 | (test-equal "fill-paragraph, large unbreakable word" | |
85 | '("Here is a" "very-very-long-word" | |
86 | "and that's" "it.") | |
87 | (string-split | |
88 | (fill-paragraph "Here is a very-very-long-word and that's it." | |
89 | 10) | |
90 | #\newline)) | |
91 | ||
3a09e1d2 CS |
92 | (test-equal "fill-paragraph, two spaces after period" |
93 | "First line. Second line" | |
94 | (fill-paragraph "First line. | |
95 | Second line" 24)) | |
96 | ||
08d7e359 LC |
97 | (test-equal "package-description-string vs. Unicode" |
98 | "b•ll•t\n\n" ;see <http://bugs.gnu.org/21536> | |
99 | (with-fluids ((%default-port-encoding "ISO-8859-1")) | |
100 | (package-description-string | |
101 | (dummy-package "foo" (description "b•ll•t"))))) | |
102 | ||
2876b989 LC |
103 | (test-equal "package-specification->name+version+output" |
104 | '(("guile" #f "out") | |
105 | ("guile" "2.0.9" "out") | |
106 | ("guile" #f "debug") | |
107 | ("guile" "2.0.9" "debug") | |
108 | ("guile-cairo" "1.4.1" "out")) | |
109 | (map (lambda (spec) | |
110 | (call-with-values | |
111 | (lambda () | |
112 | (package-specification->name+version+output spec)) | |
113 | list)) | |
114 | '("guile" | |
1b846da8 | 115 | "guile@2.0.9" |
2876b989 | 116 | "guile:debug" |
1b846da8 ML |
117 | "guile@2.0.9:debug" |
118 | "guile-cairo@1.4.1"))) | |
2876b989 | 119 | |
2cd09108 NK |
120 | (test-equal "integer" |
121 | '(1) | |
122 | (string->generations "1")) | |
123 | ||
124 | (test-equal "comma-separated integers" | |
125 | '(3 7 1 4 6) | |
126 | (string->generations "3,7,1,4,6")) | |
127 | ||
128 | (test-equal "closed range" | |
129 | '(4 5 6 7 8 9 10 11 12) | |
130 | (string->generations "4..12")) | |
131 | ||
132 | (test-equal "closed range, equal endpoints" | |
133 | '(3) | |
134 | (string->generations "3..3")) | |
135 | ||
136 | (test-equal "indefinite end range" | |
137 | '(>= 7) | |
138 | (string->generations "7..")) | |
139 | ||
140 | (test-equal "indefinite start range" | |
141 | '(<= 42) | |
142 | (string->generations "..42")) | |
143 | ||
144 | (test-equal "integer, char" | |
145 | #f | |
146 | (string->generations "a")) | |
147 | ||
148 | (test-equal "comma-separated integers, consecutive comma" | |
149 | #f | |
150 | (string->generations "1,,2")) | |
151 | ||
152 | (test-equal "comma-separated integers, trailing comma" | |
153 | #f | |
154 | (string->generations "1,2,")) | |
155 | ||
156 | (test-equal "comma-separated integers, chars" | |
157 | #f | |
158 | (string->generations "a,b")) | |
159 | ||
160 | (test-equal "closed range, start > end" | |
161 | #f | |
162 | (string->generations "9..2")) | |
163 | ||
164 | (test-equal "closed range, chars" | |
165 | #f | |
166 | (string->generations "a..b")) | |
167 | ||
168 | (test-equal "indefinite end range, char" | |
169 | #f | |
170 | (string->generations "a..")) | |
171 | ||
172 | (test-equal "indefinite start range, char" | |
173 | #f | |
174 | (string->generations "..a")) | |
175 | ||
176 | (test-equal "duration, 1 day" | |
177 | (make-time time-duration 0 (* 3600 24)) | |
178 | (string->duration "1d")) | |
179 | ||
180 | (test-equal "duration, 1 week" | |
181 | (make-time time-duration 0 (* 3600 24 7)) | |
182 | (string->duration "1w")) | |
183 | ||
184 | (test-equal "duration, 1 month" | |
185 | (make-time time-duration 0 (* 3600 24 30)) | |
186 | (string->duration "1m")) | |
187 | ||
188 | (test-equal "duration, 1 week == 7 days" | |
189 | (string->duration "1w") | |
190 | (string->duration "7d")) | |
191 | ||
192 | (test-equal "duration, 1 month == 30 days" | |
193 | (string->duration "1m") | |
194 | (string->duration "30d")) | |
195 | ||
30d2397f LC |
196 | (test-equal "duration, 2 hours" |
197 | 7200 | |
198 | (time-second (string->duration "2h"))) | |
199 | ||
638c5b79 LC |
200 | (test-equal "duration, 1 second" |
201 | (make-time time-duration 0 1) | |
202 | (string->duration "1s")) | |
203 | ||
2cd09108 NK |
204 | (test-equal "duration, integer" |
205 | #f | |
206 | (string->duration "1")) | |
207 | ||
208 | (test-equal "duration, char" | |
209 | #f | |
210 | (string->duration "d")) | |
211 | ||
1d6243cf LC |
212 | (test-equal "size->number, bytes" |
213 | 42 | |
214 | (size->number "42")) | |
215 | ||
216 | (test-equal "size->number, MiB" | |
217 | (* 42 (expt 2 20)) | |
218 | (size->number "42MiB")) | |
219 | ||
220 | (test-equal "size->number, GiB" | |
221 | (* 3 (expt 2 30)) | |
222 | (size->number "3GiB")) | |
223 | ||
224 | (test-equal "size->number, 1.2GiB" | |
225 | (inexact->exact (round (* 1.2 (expt 2 30)))) | |
226 | (size->number "1.2GiB")) | |
227 | ||
4a44d7bb LC |
228 | (test-equal "size->number, 1T" |
229 | (expt 2 40) | |
230 | (size->number "1T")) | |
231 | ||
fa99c4bb LC |
232 | (test-equal "size->number, 1.M" |
233 | (expt 2 20) | |
234 | (size->number "1.M")) | |
235 | ||
1d6243cf LC |
236 | (test-assert "size->number, invalid unit" |
237 | (catch 'quit | |
238 | (lambda () | |
239 | (size->number "9X")) | |
240 | (lambda args | |
241 | #t))) | |
242 | ||
52ddf2ae LC |
243 | (test-equal "show-what-to-build, zero outputs" |
244 | "" | |
245 | (with-store store | |
246 | (let ((drv (derivation store "zero" "/bin/sh" '() | |
247 | #:outputs '()))) | |
248 | (with-error-to-string | |
249 | (lambda () | |
250 | ;; This should print nothing. | |
251 | (show-what-to-build store (list drv))))))) | |
252 | ||
5d7a8584 AK |
253 | (test-assert "show-manifest-transaction" |
254 | (let* ((m (manifest (list guile-1.8.8))) | |
255 | (t (manifest-transaction (install (list guile-2.0.9))))) | |
77ee4a96 | 256 | (with-store store |
c136da3f | 257 | (and (string-match "guile +1.8.8 → 2.0.9" |
77ee4a96 LC |
258 | (with-fluids ((%default-port-encoding "UTF-8")) |
259 | (with-error-to-string | |
260 | (lambda () | |
261 | (show-manifest-transaction store m t))))) | |
c136da3f | 262 | (string-match "guile +1.8.8 -> 2.0.9" |
1062063a LC |
263 | (with-error-to-string |
264 | (lambda () | |
265 | ;; In Guile 2.2, %DEFAULT-PORT-ENCODING doesn't | |
266 | ;; influence the encoding of string ports. | |
267 | (set-port-encoding! (current-error-port) | |
268 | "ISO-8859-1") | |
269 | (show-manifest-transaction store m t)))))))) | |
5d7a8584 | 270 | |
8874faaa LC |
271 | (test-assert "package-relevance" |
272 | (let ((guile (specification->package "guile")) | |
273 | (gcrypt (specification->package "guile-gcrypt")) | |
274 | (go (specification->package "go")) | |
275 | (gnugo (specification->package "gnugo")) | |
d2cdef65 | 276 | (libb2 (specification->package "libb2")) |
8874faaa LC |
277 | (rx (cut make-regexp <> regexp/icase)) |
278 | (>0 (cut > <> 0)) | |
279 | (=0 zero?)) | |
280 | (and (>0 (package-relevance guile | |
281 | (map rx '("scheme")))) | |
282 | (>0 (package-relevance guile | |
283 | (map rx '("scheme" "implementation")))) | |
284 | (>0 (package-relevance gcrypt | |
285 | (map rx '("guile" "crypto")))) | |
286 | (=0 (package-relevance guile | |
287 | (map rx '("guile" "crypto")))) | |
288 | (>0 (package-relevance go | |
289 | (map rx '("go")))) | |
290 | (=0 (package-relevance go | |
291 | (map rx '("go" "game")))) | |
292 | (>0 (package-relevance gnugo | |
d2cdef65 | 293 | (map rx '("go" "game")))) |
294 | (>0 (package-relevance libb2 | |
295 | (map rx '("crypto" "library"))))))) | |
8874faaa | 296 | |
bbcd06e5 LDB |
297 | (test-assert "package-relevance and upstream name" |
298 | ;; https://issues.guix.gnu.org/58136 | |
299 | (let ((ggplot2 (specification->package "r-ggplot2")) | |
300 | (ggstance (specification->package "r-ggstance")) | |
301 | (rx (make-regexp "ggplot2" regexp/icase))) | |
302 | (> (package-relevance ggplot2 (list rx)) | |
303 | (package-relevance ggstance (list rx)) | |
304 | 0))) | |
305 | ||
c8803d89 TH |
306 | (define (make-empty-file directory file) |
307 | ;; Create FILE in DIRECTORY. | |
308 | (close-port (open-output-file (in-vicinity directory file)))) | |
309 | ||
310 | (define (assert-equals-find-available-pager expected) | |
311 | ;; Use 'with-paginated-output-port' and return true if it invoked EXPECTED. | |
312 | (define used-command "") | |
313 | (mock ((ice-9 popen) open-pipe* | |
314 | (lambda (mode command . args) | |
315 | (unless (string-null? used-command) | |
316 | (error "open-pipe* should only be called once")) | |
317 | (set! used-command command) | |
318 | (%make-void-port ""))) | |
319 | (mock ((ice-9 popen) close-pipe (const 'ok)) | |
320 | (mock ((guix colors) isatty?* (const #t)) | |
321 | (with-paginated-output-port port 'ok) | |
322 | (string=? expected used-command))))) | |
323 | ||
324 | ||
325 | (test-assert "find-available-pager, GUIX_PAGER takes precedence" | |
326 | (call-with-temporary-directory | |
327 | (lambda (dir) | |
328 | (with-environment-variables `(("PATH" ,dir) | |
329 | ("GUIX_PAGER" "guix-pager") | |
330 | ("PAGER" "pager")) | |
331 | (make-empty-file dir "less") | |
332 | (make-empty-file dir "more") | |
333 | (assert-equals-find-available-pager "guix-pager"))))) | |
334 | ||
335 | (test-assert "find-available-pager, PAGER takes precedence" | |
336 | (call-with-temporary-directory | |
337 | (lambda (dir) | |
338 | (with-environment-variables `(("PATH" ,dir) | |
339 | ("GUIX_PAGER" #false) | |
340 | ("PAGER" "pager")) | |
341 | (make-empty-file dir "less") | |
342 | (make-empty-file dir "more") | |
343 | (assert-equals-find-available-pager "pager"))))) | |
344 | ||
345 | (test-assert "find-available-pager, 'less' takes precedence" | |
346 | (call-with-temporary-directory | |
347 | (lambda (dir) | |
348 | (with-environment-variables `(("PATH" ,dir) | |
349 | ("GUIX_PAGER" #false) | |
350 | ("PAGER" #false)) | |
351 | (make-empty-file dir "less") | |
352 | (make-empty-file dir "more") | |
353 | (assert-equals-find-available-pager (in-vicinity dir "less")))))) | |
354 | ||
355 | (test-assert "find-available-pager, 'more' takes precedence" | |
356 | (call-with-temporary-directory | |
357 | (lambda (dir) | |
358 | (with-environment-variables `(("PATH" ,dir) | |
359 | ("GUIX_PAGER" #false) | |
360 | ("PAGER" #false)) | |
361 | (make-empty-file dir "more") | |
362 | (assert-equals-find-available-pager (in-vicinity dir "more")))))) | |
363 | ||
364 | (test-assert "find-available-pager, no pager" | |
365 | (call-with-temporary-directory | |
366 | (lambda (dir) | |
367 | (with-environment-variables `(("PATH" ,dir) | |
368 | ("GUIX_PAGER" #false) | |
369 | ("PAGER" #false)) | |
370 | (assert-equals-find-available-pager ""))))) | |
371 | ||
299112d3 | 372 | (test-end "ui") |