tests/ui.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
   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)
  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))
  32
  33 ;; Test the (guix ui) module.
  34
  35 (define %paragraph
  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.")
  42
  43 (define guile-1.8.8
  44   (manifest-entry
  45     (name "guile")
  46     (version "1.8.8")
  47     (item "/gnu/store/...")
  48     (output "out")))
  49
  50 (define guile-2.0.9
  51   (manifest-entry
  52     (name "guile")
  53     (version "2.0.9")
  54     (item "/gnu/store/...")
  55     (output "out")))
  56
  57 (define-syntax-rule (with-environment-variable variable value body ...)
  58   "Run BODY with VARIABLE set to VALUE."
  59   (let ((orig (getenv variable)))
  60     (dynamic-wind
  61       (lambda ()
  62         (setenv variable value))
  63       (lambda ()
  64         body ...)
  65       (lambda ()
  66         (if orig
  67             (setenv variable orig)
  68             (unsetenv variable))))))
  69
  70 \f
  71 (test-begin "ui")
  72
  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))
  78
  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
  83                         (list '()))))
  84
  85 (test-equal "parse-command-line and --no options"
  86   '((argument . "foo")
  87     (substitutes? . #f))                          ;takes precedence
  88
  89   (with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes"
  90     (parse-command-line '("foo")
  91                         %standard-build-options
  92                         (list '((substitutes? . #t))))))
  93
  94 (test-assert "fill-paragraph"
  95   (every (lambda (column)
  96            (every (lambda (width)
  97                     (every (lambda (line)
  98                              (<= (string-length line) width))
  99                            (string-split (fill-paragraph %paragraph
 100                                                          width column)
 101                                          #\newline)))
 102                   '(15 30 35 40 45 50 60 70 80 90 100)))
 103    '(0 5)))
 104
 105 (test-assert "fill-paragraph, consecutive newlines"
 106   (every (lambda (width)
 107            (any (lambda (line)
 108                   (string-prefix? "When STR" line))
 109                 (string-split
 110                  (fill-paragraph (procedure-documentation fill-paragraph)
 111                                  width)
 112                  #\newline)))
 113          '(15 20 25 30 40 50 60)))
 114
 115 (test-equal "fill-paragraph, large unbreakable word"
 116   '("Here is a" "very-very-long-word"
 117     "and that's" "it.")
 118   (string-split
 119    (fill-paragraph "Here is a very-very-long-word and that's it."
 120                    10)
 121    #\newline))
 122
 123 (test-equal "fill-paragraph, two spaces after period"
 124   "First line.  Second line"
 125   (fill-paragraph "First line.
 126 Second line" 24))
 127
 128 (test-equal "package-specification->name+version+output"
 129   '(("guile" #f "out")
 130     ("guile" "2.0.9" "out")
 131     ("guile" #f "debug")
 132     ("guile" "2.0.9" "debug")
 133     ("guile-cairo" "1.4.1" "out"))
 134   (map (lambda (spec)
 135          (call-with-values
 136              (lambda ()
 137                (package-specification->name+version+output spec))
 138            list))
 139        '("guile"
 140          "guile-2.0.9"
 141          "guile:debug"
 142          "guile-2.0.9:debug"
 143          "guile-cairo-1.4.1")))
 144
 145 (test-equal "integer"
 146   '(1)
 147   (string->generations "1"))
 148
 149 (test-equal "comma-separated integers"
 150   '(3 7 1 4 6)
 151   (string->generations "3,7,1,4,6"))
 152
 153 (test-equal "closed range"
 154   '(4 5 6 7 8 9 10 11 12)
 155   (string->generations "4..12"))
 156
 157 (test-equal "closed range, equal endpoints"
 158   '(3)
 159   (string->generations "3..3"))
 160
 161 (test-equal "indefinite end range"
 162   '(>= 7)
 163   (string->generations "7.."))
 164
 165 (test-equal "indefinite start range"
 166   '(<= 42)
 167   (string->generations "..42"))
 168
 169 (test-equal "integer, char"
 170   #f
 171   (string->generations "a"))
 172
 173 (test-equal "comma-separated integers, consecutive comma"
 174   #f
 175   (string->generations "1,,2"))
 176
 177 (test-equal "comma-separated integers, trailing comma"
 178   #f
 179   (string->generations "1,2,"))
 180
 181 (test-equal "comma-separated integers, chars"
 182   #f
 183   (string->generations "a,b"))
 184
 185 (test-equal "closed range, start > end"
 186   #f
 187   (string->generations "9..2"))
 188
 189 (test-equal "closed range, chars"
 190   #f
 191   (string->generations "a..b"))
 192
 193 (test-equal "indefinite end range, char"
 194   #f
 195   (string->generations "a.."))
 196
 197 (test-equal "indefinite start range, char"
 198   #f
 199   (string->generations "..a"))
 200
 201 (test-equal "duration, 1 day"
 202   (make-time time-duration 0 (* 3600 24))
 203   (string->duration "1d"))
 204
 205 (test-equal "duration, 1 week"
 206   (make-time time-duration 0 (* 3600 24 7))
 207   (string->duration "1w"))
 208
 209 (test-equal "duration, 1 month"
 210   (make-time time-duration 0 (* 3600 24 30))
 211   (string->duration "1m"))
 212
 213 (test-equal "duration, 1 week == 7 days"
 214   (string->duration "1w")
 215   (string->duration "7d"))
 216
 217 (test-equal "duration, 1 month == 30 days"
 218   (string->duration "1m")
 219   (string->duration "30d"))
 220
 221 (test-equal "duration, integer"
 222   #f
 223   (string->duration "1"))
 224
 225 (test-equal "duration, char"
 226   #f
 227   (string->duration "d"))
 228
 229 (test-equal "size->number, bytes"
 230   42
 231   (size->number "42"))
 232
 233 (test-equal "size->number, MiB"
 234   (* 42 (expt 2 20))
 235   (size->number "42MiB"))
 236
 237 (test-equal "size->number, GiB"
 238   (* 3 (expt 2 30))
 239   (size->number "3GiB"))
 240
 241 (test-equal "size->number, 1.2GiB"
 242   (inexact->exact (round (* 1.2 (expt 2 30))))
 243   (size->number "1.2GiB"))
 244
 245 (test-equal "size->number, 1T"
 246   (expt 2 40)
 247   (size->number "1T"))
 248
 249 (test-assert "size->number, invalid unit"
 250   (catch 'quit
 251     (lambda ()
 252       (size->number "9X"))
 253     (lambda args
 254       #t)))
 255
 256 (test-equal "show-what-to-build, zero outputs"
 257   ""
 258   (with-store store
 259     (let ((drv (derivation store "zero" "/bin/sh" '()
 260                            #:outputs '())))
 261       (with-error-to-string
 262        (lambda ()
 263          ;; This should print nothing.
 264          (show-what-to-build store (list drv)))))))
 265
 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)))))
 269     (with-store store
 270       (and (string-match "guile\t1.8.8 → 2.0.9"
 271                          (with-fluids ((%default-port-encoding "UTF-8"))
 272                            (with-error-to-string
 273                             (lambda ()
 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
 278                             (lambda ()
 279                               (show-manifest-transaction store m t)))))))))
 280
 281 (test-end "ui")
 282
 283 \f
 284 (exit (= (test-runner-fail-count (test-runner-current)) 0))
 285
 286 ;;; Local Variables:
 287 ;;; eval: (put 'with-environment-variable 'scheme-indent-function 2)
 288 ;;; End: