1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
20 (define-module (test-ui)
21 #:use-module (guix ui)
22 #:use-module (guix profiles)
23 #:use-module (guix store)
24 #:use-module (guix derivations)
25 #:use-module ((guix scripts build)
26 #:select (%standard-build-options))
27 #:use-module (srfi srfi-1)
28 #:use-module (srfi srfi-11)
29 #:use-module (srfi srfi-19)
30 #:use-module (srfi srfi-64)
31 #:use-module (ice-9 regex))
33 ;; Test the (guix ui) module.
36 "GNU Guile is an implementation of the Scheme programming language, with
37 support for many SRFIs, packaged for use in a wide variety of environments.
38 In addition to implementing the R5RS Scheme standard and a large subset of
39 R6RS, Guile includes a module system, full access to POSIX system calls,
40 networking support, multiple threads, dynamic linking, a foreign function call
41 interface, and powerful string processing.")
47 (item "/gnu/store/...")
54 (item "/gnu/store/...")
57 (define-syntax-rule (with-environment-variable variable value body ...)
58 "Run BODY with VARIABLE set to VALUE."
59 (let ((orig (getenv variable)))
62 (setenv variable value))
67 (setenv variable orig)
68 (unsetenv variable))))))
73 (test-equal "parse-command-line"
74 '((argument . "bar") (argument . "foo")
75 (cores . 10) ;takes precedence
76 (substitutes? . #f) (keep-failed? . #t)
77 (max-jobs . 77) (cores . 42))
79 (with-environment-variable "GUIX_BUILD_OPTIONS" "-c 42 -M 77"
80 (parse-command-line '("--keep-failed" "--no-substitutes"
81 "--cores=10" "foo" "bar")
82 %standard-build-options
85 (test-equal "parse-command-line and --no options"
87 (substitutes? . #f)) ;takes precedence
89 (with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes"
90 (parse-command-line '("foo")
91 %standard-build-options
92 (list '((substitutes? . #t))))))
94 (test-assert "fill-paragraph"
95 (every (lambda (column)
96 (every (lambda (width)
98 (<= (string-length line) width))
99 (string-split (fill-paragraph %paragraph
102 '(15 30 35 40 45 50 60 70 80 90 100)))
105 (test-assert "fill-paragraph, consecutive newlines"
106 (every (lambda (width)
108 (string-prefix? "When STR" line))
110 (fill-paragraph (procedure-documentation fill-paragraph)
113 '(15 20 25 30 40 50 60)))
115 (test-equal "fill-paragraph, large unbreakable word"
116 '("Here is a" "very-very-long-word"
119 (fill-paragraph "Here is a very-very-long-word and that's it."
123 (test-equal "fill-paragraph, two spaces after period"
124 "First line. Second line"
125 (fill-paragraph "First line.
128 (test-equal "package-specification->name+version+output"
130 ("guile" "2.0.9" "out")
132 ("guile" "2.0.9" "debug")
133 ("guile-cairo" "1.4.1" "out"))
137 (package-specification->name+version+output spec))
143 "guile-cairo-1.4.1")))
145 (test-equal "integer"
147 (string->generations "1"))
149 (test-equal "comma-separated integers"
151 (string->generations "3,7,1,4,6"))
153 (test-equal "closed range"
154 '(4 5 6 7 8 9 10 11 12)
155 (string->generations "4..12"))
157 (test-equal "closed range, equal endpoints"
159 (string->generations "3..3"))
161 (test-equal "indefinite end range"
163 (string->generations "7.."))
165 (test-equal "indefinite start range"
167 (string->generations "..42"))
169 (test-equal "integer, char"
171 (string->generations "a"))
173 (test-equal "comma-separated integers, consecutive comma"
175 (string->generations "1,,2"))
177 (test-equal "comma-separated integers, trailing comma"
179 (string->generations "1,2,"))
181 (test-equal "comma-separated integers, chars"
183 (string->generations "a,b"))
185 (test-equal "closed range, start > end"
187 (string->generations "9..2"))
189 (test-equal "closed range, chars"
191 (string->generations "a..b"))
193 (test-equal "indefinite end range, char"
195 (string->generations "a.."))
197 (test-equal "indefinite start range, char"
199 (string->generations "..a"))
201 (test-equal "duration, 1 day"
202 (make-time time-duration 0 (* 3600 24))
203 (string->duration "1d"))
205 (test-equal "duration, 1 week"
206 (make-time time-duration 0 (* 3600 24 7))
207 (string->duration "1w"))
209 (test-equal "duration, 1 month"
210 (make-time time-duration 0 (* 3600 24 30))
211 (string->duration "1m"))
213 (test-equal "duration, 1 week == 7 days"
214 (string->duration "1w")
215 (string->duration "7d"))
217 (test-equal "duration, 1 month == 30 days"
218 (string->duration "1m")
219 (string->duration "30d"))
221 (test-equal "duration, integer"
223 (string->duration "1"))
225 (test-equal "duration, char"
227 (string->duration "d"))
229 (test-equal "size->number, bytes"
233 (test-equal "size->number, MiB"
235 (size->number "42MiB"))
237 (test-equal "size->number, GiB"
239 (size->number "3GiB"))
241 (test-equal "size->number, 1.2GiB"
242 (inexact->exact (round (* 1.2 (expt 2 30))))
243 (size->number "1.2GiB"))
245 (test-equal "size->number, 1T"
249 (test-assert "size->number, invalid unit"
256 (test-equal "show-what-to-build, zero outputs"
259 (let ((drv (derivation store "zero" "/bin/sh" '()
261 (with-error-to-string
263 ;; This should print nothing.
264 (show-what-to-build store (list drv)))))))
266 (test-assert "show-manifest-transaction"
267 (let* ((m (manifest (list guile-1.8.8)))
268 (t (manifest-transaction (install (list guile-2.0.9)))))
270 (and (string-match "guile\t1.8.8 → 2.0.9"
271 (with-fluids ((%default-port-encoding "UTF-8"))
272 (with-error-to-string
274 (show-manifest-transaction store m t)))))
275 (string-match "guile\t1.8.8 -> 2.0.9"
276 (with-fluids ((%default-port-encoding "ISO-8859-1"))
277 (with-error-to-string
279 (show-manifest-transaction store m t)))))))))
284 (exit (= (test-runner-fail-count (test-runner-current)) 0))
287 ;;; eval: (put 'with-environment-variable 'scheme-indent-function 2)