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 (srfi srfi-1)
26 #:use-module (srfi srfi-11)
27 #:use-module (srfi srfi-19)
28 #:use-module (srfi srfi-64)
29 #:use-module (ice-9 regex))
31 ;; Test the (guix ui) module.
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.")
45 (item "/gnu/store/...")
52 (item "/gnu/store/...")
58 (test-assert "fill-paragraph"
59 (every (lambda (column)
60 (every (lambda (width)
62 (<= (string-length line) width))
63 (string-split (fill-paragraph %paragraph
66 '(15 30 35 40 45 50 60 70 80 90 100)))
69 (test-assert "fill-paragraph, consecutive newlines"
70 (every (lambda (width)
72 (string-prefix? "When STR" line))
74 (fill-paragraph (procedure-documentation fill-paragraph)
77 '(15 20 25 30 40 50 60)))
79 (test-equal "fill-paragraph, large unbreakable word"
80 '("Here is a" "very-very-long-word"
83 (fill-paragraph "Here is a very-very-long-word and that's it."
87 (test-equal "fill-paragraph, two spaces after period"
88 "First line. Second line"
89 (fill-paragraph "First line.
92 (test-equal "package-specification->name+version+output"
94 ("guile" "2.0.9" "out")
96 ("guile" "2.0.9" "debug")
97 ("guile-cairo" "1.4.1" "out"))
101 (package-specification->name+version+output spec))
107 "guile-cairo-1.4.1")))
109 (test-equal "integer"
111 (string->generations "1"))
113 (test-equal "comma-separated integers"
115 (string->generations "3,7,1,4,6"))
117 (test-equal "closed range"
118 '(4 5 6 7 8 9 10 11 12)
119 (string->generations "4..12"))
121 (test-equal "closed range, equal endpoints"
123 (string->generations "3..3"))
125 (test-equal "indefinite end range"
127 (string->generations "7.."))
129 (test-equal "indefinite start range"
131 (string->generations "..42"))
133 (test-equal "integer, char"
135 (string->generations "a"))
137 (test-equal "comma-separated integers, consecutive comma"
139 (string->generations "1,,2"))
141 (test-equal "comma-separated integers, trailing comma"
143 (string->generations "1,2,"))
145 (test-equal "comma-separated integers, chars"
147 (string->generations "a,b"))
149 (test-equal "closed range, start > end"
151 (string->generations "9..2"))
153 (test-equal "closed range, chars"
155 (string->generations "a..b"))
157 (test-equal "indefinite end range, char"
159 (string->generations "a.."))
161 (test-equal "indefinite start range, char"
163 (string->generations "..a"))
165 (test-equal "duration, 1 day"
166 (make-time time-duration 0 (* 3600 24))
167 (string->duration "1d"))
169 (test-equal "duration, 1 week"
170 (make-time time-duration 0 (* 3600 24 7))
171 (string->duration "1w"))
173 (test-equal "duration, 1 month"
174 (make-time time-duration 0 (* 3600 24 30))
175 (string->duration "1m"))
177 (test-equal "duration, 1 week == 7 days"
178 (string->duration "1w")
179 (string->duration "7d"))
181 (test-equal "duration, 1 month == 30 days"
182 (string->duration "1m")
183 (string->duration "30d"))
185 (test-equal "duration, integer"
187 (string->duration "1"))
189 (test-equal "duration, char"
191 (string->duration "d"))
193 (test-equal "size->number, bytes"
197 (test-equal "size->number, MiB"
199 (size->number "42MiB"))
201 (test-equal "size->number, GiB"
203 (size->number "3GiB"))
205 (test-equal "size->number, 1.2GiB"
206 (inexact->exact (round (* 1.2 (expt 2 30))))
207 (size->number "1.2GiB"))
209 (test-equal "size->number, 1T"
213 (test-assert "size->number, invalid unit"
220 (test-equal "show-what-to-build, zero outputs"
223 (let ((drv (derivation store "zero" "/bin/sh" '()
225 (with-error-to-string
227 ;; This should print nothing.
228 (show-what-to-build store (list drv)))))))
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)))))
234 (and (string-match "guile\t1.8.8 → 2.0.9"
235 (with-fluids ((%default-port-encoding "UTF-8"))
236 (with-error-to-string
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
243 (show-manifest-transaction store m t)))))))))
248 (exit (= (test-runner-fail-count (test-runner-current)) 0))