tests/ui.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017 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 tests)
  26   #:use-module (srfi srfi-1)
  27   #:use-module (srfi srfi-11)
  28   #:use-module (srfi srfi-19)
  29   #:use-module (srfi srfi-64)
  30   #:use-module (ice-9 regex))
  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
  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
  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
  88 (test-equal "fill-paragraph, two spaces after period"
  89   "First line.  Second line"
  90   (fill-paragraph "First line.
  91 Second line" 24))
  92
  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
  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"
 111          "guile@2.0.9"
 112          "guile:debug"
 113          "guile@2.0.9:debug"
 114          "guile-cairo@1.4.1")))
 115
 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
 192 (test-equal "duration, 2 hours"
 193   7200
 194   (time-second (string->duration "2h")))
 195
 196 (test-equal "duration, 1 second"
 197   (make-time time-duration 0 1)
 198   (string->duration "1s"))
 199
 200 (test-equal "duration, integer"
 201   #f
 202   (string->duration "1"))
 203
 204 (test-equal "duration, char"
 205   #f
 206   (string->duration "d"))
 207
 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
 224 (test-equal "size->number, 1T"
 225   (expt 2 40)
 226   (size->number "1T"))
 227
 228 (test-assert "size->number, invalid unit"
 229   (catch 'quit
 230     (lambda ()
 231       (size->number "9X"))
 232     (lambda args
 233       #t)))
 234
 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
 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)))))
 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"
 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))))))))
 262
 263 (test-end "ui")