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