X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/299112d36e872d98896bf8dec281c34d9adad06e..e0b47290a704c954d00d86e0c120fe44946f29f9:/tests/ui.scm

diff --git a/tests/ui.scm b/tests/ui.scm
index 0b6f3c5815..058207e8b9 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,8 +19,15 @@
 
 (define-module (test-ui)
   #:use-module (guix ui)
+  #:use-module (guix profiles)
+  #:use-module (guix store)
+  #:use-module (guix derivations)
+  #:use-module (guix tests)
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-64))
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-64)
+  #:use-module (ice-9 regex))
 
 ;; Test the (guix ui) module.
 
@@ -32,6 +39,20 @@ R6RS, Guile includes a module system, full access to POSIX system calls,
 networking support, multiple threads, dynamic linking, a foreign function call
 interface, and powerful string processing.")
 
+(define guile-1.8.8
+  (manifest-entry
+    (name "guile")
+    (version "1.8.8")
+    (item "/gnu/store/...")
+    (output "out")))
+
+(define guile-2.0.9
+  (manifest-entry
+    (name "guile")
+    (version "2.0.9")
+    (item "/gnu/store/...")
+    (output "out")))
+
 
 (test-begin "ui")
 
@@ -64,7 +85,172 @@ interface, and powerful string processing.")
                    10)
    #\newline))
 
-(test-end "ui")
+(test-equal "fill-paragraph, two spaces after period"
+  "First line.  Second line"
+  (fill-paragraph "First line.
+Second line" 24))
 
-
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
+(test-equal "package-description-string vs. Unicode"
+  "b•ll•t\n\n"                                ;see <http://bugs.gnu.org/21536>
+  (with-fluids ((%default-port-encoding "ISO-8859-1"))
+    (package-description-string
+     (dummy-package "foo" (description "b•ll•t")))))
+
+(test-equal "package-specification->name+version+output"
+  '(("guile" #f "out")
+    ("guile" "2.0.9" "out")
+    ("guile" #f "debug")
+    ("guile" "2.0.9" "debug")
+    ("guile-cairo" "1.4.1" "out"))
+  (map (lambda (spec)
+         (call-with-values
+             (lambda ()
+               (package-specification->name+version+output spec))
+           list))
+       '("guile"
+         "guile@2.0.9"
+         "guile:debug"
+         "guile@2.0.9:debug"
+         "guile-cairo@1.4.1")))
+
+(test-equal "integer"
+  '(1)
+  (string->generations "1"))
+
+(test-equal "comma-separated integers"
+  '(3 7 1 4 6)
+  (string->generations "3,7,1,4,6"))
+
+(test-equal "closed range"
+  '(4 5 6 7 8 9 10 11 12)
+  (string->generations "4..12"))
+
+(test-equal "closed range, equal endpoints"
+  '(3)
+  (string->generations "3..3"))
+
+(test-equal "indefinite end range"
+  '(>= 7)
+  (string->generations "7.."))
+
+(test-equal "indefinite start range"
+  '(<= 42)
+  (string->generations "..42"))
+
+(test-equal "integer, char"
+  #f
+  (string->generations "a"))
+
+(test-equal "comma-separated integers, consecutive comma"
+  #f
+  (string->generations "1,,2"))
+
+(test-equal "comma-separated integers, trailing comma"
+  #f
+  (string->generations "1,2,"))
+
+(test-equal "comma-separated integers, chars"
+  #f
+  (string->generations "a,b"))
+
+(test-equal "closed range, start > end"
+  #f
+  (string->generations "9..2"))
+
+(test-equal "closed range, chars"
+  #f
+  (string->generations "a..b"))
+
+(test-equal "indefinite end range, char"
+  #f
+  (string->generations "a.."))
+
+(test-equal "indefinite start range, char"
+  #f
+  (string->generations "..a"))
+
+(test-equal "duration, 1 day"
+  (make-time time-duration 0 (* 3600 24))
+  (string->duration "1d"))
+
+(test-equal "duration, 1 week"
+  (make-time time-duration 0 (* 3600 24 7))
+  (string->duration "1w"))
+
+(test-equal "duration, 1 month"
+  (make-time time-duration 0 (* 3600 24 30))
+  (string->duration "1m"))
+
+(test-equal "duration, 1 week == 7 days"
+  (string->duration "1w")
+  (string->duration "7d"))
+
+(test-equal "duration, 1 month == 30 days"
+  (string->duration "1m")
+  (string->duration "30d"))
+
+(test-equal "duration, 1 second"
+  (make-time time-duration 0 1)
+  (string->duration "1s"))
+
+(test-equal "duration, integer"
+  #f
+  (string->duration "1"))
+
+(test-equal "duration, char"
+  #f
+  (string->duration "d"))
+
+(test-equal "size->number, bytes"
+  42
+  (size->number "42"))
+
+(test-equal "size->number, MiB"
+  (* 42 (expt 2 20))
+  (size->number "42MiB"))
+
+(test-equal "size->number, GiB"
+  (* 3 (expt 2 30))
+  (size->number "3GiB"))
+
+(test-equal "size->number, 1.2GiB"
+  (inexact->exact (round (* 1.2 (expt 2 30))))
+  (size->number "1.2GiB"))
+
+(test-equal "size->number, 1T"
+  (expt 2 40)
+  (size->number "1T"))
+
+(test-assert "size->number, invalid unit"
+  (catch 'quit
+    (lambda ()
+      (size->number "9X"))
+    (lambda args
+      #t)))
+
+(test-equal "show-what-to-build, zero outputs"
+  ""
+  (with-store store
+    (let ((drv (derivation store "zero" "/bin/sh" '()
+                           #:outputs '())))
+      (with-error-to-string
+       (lambda ()
+         ;; This should print nothing.
+         (show-what-to-build store (list drv)))))))
+
+(test-assert "show-manifest-transaction"
+  (let* ((m (manifest (list guile-1.8.8)))
+         (t (manifest-transaction (install (list guile-2.0.9)))))
+    (with-store store
+      (and (string-match "guile\t1.8.8 → 2.0.9"
+                         (with-fluids ((%default-port-encoding "UTF-8"))
+                           (with-error-to-string
+                            (lambda ()
+                              (show-manifest-transaction store m t)))))
+           (string-match "guile\t1.8.8 -> 2.0.9"
+                         (with-fluids ((%default-port-encoding "ISO-8859-1"))
+                           (with-error-to-string
+                            (lambda ()
+                              (show-manifest-transaction store m t)))))))))
+
+(test-end "ui")