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 (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))
  30
  31 ;; Test the (guix ui) module.
  32
  33 (define %paragraph
  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.")
  40
  41 (define guile-1.8.8
  42   (manifest-entry
  43     (name "guile")
  44     (version "1.8.8")
  45     (item "/gnu/store/...")
  46     (output "out")))
  47
  48 (define guile-2.0.9
  49   (manifest-entry
  50     (name "guile")
  51     (version "2.0.9")
  52     (item "/gnu/store/...")
  53     (output "out")))
  54
  55 \f
  56 (test-begin "ui")
  57
  58 (test-assert "fill-paragraph"
  59   (every (lambda (column)
  60            (every (lambda (width)
  61                     (every (lambda (line)
  62                              (<= (string-length line) width))
  63                            (string-split (fill-paragraph %paragraph
  64                                                          width column)
  65                                          #\newline)))
  66                   '(15 30 35 40 45 50 60 70 80 90 100)))
  67    '(0 5)))
  68
  69 (test-assert "fill-paragraph, consecutive newlines"
  70   (every (lambda (width)
  71            (any (lambda (line)
  72                   (string-prefix? "When STR" line))
  73                 (string-split
  74                  (fill-paragraph (procedure-documentation fill-paragraph)
  75                                  width)
  76                  #\newline)))
  77          '(15 20 25 30 40 50 60)))
  78
  79 (test-equal "fill-paragraph, large unbreakable word"
  80   '("Here is a" "very-very-long-word"
  81     "and that's" "it.")
  82   (string-split
  83    (fill-paragraph "Here is a very-very-long-word and that's it."
  84                    10)
  85    #\newline))
  86
  87 (test-equal "fill-paragraph, two spaces after period"
  88   "First line.  Second line"
  89   (fill-paragraph "First line.
  90 Second line" 24))
  91
  92 (test-equal "package-specification->name+version+output"
  93   '(("guile" #f "out")
  94     ("guile" "2.0.9" "out")
  95     ("guile" #f "debug")
  96     ("guile" "2.0.9" "debug")
  97     ("guile-cairo" "1.4.1" "out"))
  98   (map (lambda (spec)
  99          (call-with-values
 100              (lambda ()
 101                (package-specification->name+version+output spec))
 102            list))
 103        '("guile"
 104          "guile-2.0.9"
 105          "guile:debug"
 106          "guile-2.0.9:debug"
 107          "guile-cairo-1.4.1")))
 108
 109 (test-equal "integer"
 110   '(1)
 111   (string->generations "1"))
 112
 113 (test-equal "comma-separated integers"
 114   '(3 7 1 4 6)
 115   (string->generations "3,7,1,4,6"))
 116
 117 (test-equal "closed range"
 118   '(4 5 6 7 8 9 10 11 12)
 119   (string->generations "4..12"))
 120
 121 (test-equal "closed range, equal endpoints"
 122   '(3)
 123   (string->generations "3..3"))
 124
 125 (test-equal "indefinite end range"
 126   '(>= 7)
 127   (string->generations "7.."))
 128
 129 (test-equal "indefinite start range"
 130   '(<= 42)
 131   (string->generations "..42"))
 132
 133 (test-equal "integer, char"
 134   #f
 135   (string->generations "a"))
 136
 137 (test-equal "comma-separated integers, consecutive comma"
 138   #f
 139   (string->generations "1,,2"))
 140
 141 (test-equal "comma-separated integers, trailing comma"
 142   #f
 143   (string->generations "1,2,"))
 144
 145 (test-equal "comma-separated integers, chars"
 146   #f
 147   (string->generations "a,b"))
 148
 149 (test-equal "closed range, start > end"
 150   #f
 151   (string->generations "9..2"))
 152
 153 (test-equal "closed range, chars"
 154   #f
 155   (string->generations "a..b"))
 156
 157 (test-equal "indefinite end range, char"
 158   #f
 159   (string->generations "a.."))
 160
 161 (test-equal "indefinite start range, char"
 162   #f
 163   (string->generations "..a"))
 164
 165 (test-equal "duration, 1 day"
 166   (make-time time-duration 0 (* 3600 24))
 167   (string->duration "1d"))
 168
 169 (test-equal "duration, 1 week"
 170   (make-time time-duration 0 (* 3600 24 7))
 171   (string->duration "1w"))
 172
 173 (test-equal "duration, 1 month"
 174   (make-time time-duration 0 (* 3600 24 30))
 175   (string->duration "1m"))
 176
 177 (test-equal "duration, 1 week == 7 days"
 178   (string->duration "1w")
 179   (string->duration "7d"))
 180
 181 (test-equal "duration, 1 month == 30 days"
 182   (string->duration "1m")
 183   (string->duration "30d"))
 184
 185 (test-equal "duration, integer"
 186   #f
 187   (string->duration "1"))
 188
 189 (test-equal "duration, char"
 190   #f
 191   (string->duration "d"))
 192
 193 (test-equal "size->number, bytes"
 194   42
 195   (size->number "42"))
 196
 197 (test-equal "size->number, MiB"
 198   (* 42 (expt 2 20))
 199   (size->number "42MiB"))
 200
 201 (test-equal "size->number, GiB"
 202   (* 3 (expt 2 30))
 203   (size->number "3GiB"))
 204
 205 (test-equal "size->number, 1.2GiB"
 206   (inexact->exact (round (* 1.2 (expt 2 30))))
 207   (size->number "1.2GiB"))
 208
 209 (test-equal "size->number, 1T"
 210   (expt 2 40)
 211   (size->number "1T"))
 212
 213 (test-assert "size->number, invalid unit"
 214   (catch 'quit
 215     (lambda ()
 216       (size->number "9X"))
 217     (lambda args
 218       #t)))
 219
 220 (test-equal "show-what-to-build, zero outputs"
 221   ""
 222   (with-store store
 223     (let ((drv (derivation store "zero" "/bin/sh" '()
 224                            #:outputs '())))
 225       (with-error-to-string
 226        (lambda ()
 227          ;; This should print nothing.
 228          (show-what-to-build store (list drv)))))))
 229
 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)))))
 233     (with-store store
 234       (and (string-match "guile\t1.8.8 → 2.0.9"
 235                          (with-fluids ((%default-port-encoding "UTF-8"))
 236                            (with-error-to-string
 237                             (lambda ()
 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
 242                             (lambda ()
 243                               (show-manifest-transaction store m t)))))))))
 244
 245 (test-end "ui")
 246
 247 \f
 248 (exit (= (test-runner-fail-count (test-runner-current)) 0))