;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
;;;
;;; This file is part of GNU Guix.
;;;
(define-module (test-ui)
#:use-module (guix ui)
+ #:use-module (guix profiles)
#:use-module (guix store)
#:use-module (guix derivations)
+ #:use-module ((gnu packages) #:select (specification->package))
+ #:use-module (guix tests)
+ #:use-module (guix utils)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
- #:use-module (srfi srfi-64))
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-64)
+ #:use-module (ice-9 regex))
;; Test the (guix ui) module.
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")))
+
\f
(test-begin "ui")
(fill-paragraph "First line.
Second line" 24))
+(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")
(package-specification->name+version+output spec))
list))
'("guile"
- "guile-2.0.9"
+ "guile@2.0.9"
"guile:debug"
- "guile-2.0.9:debug"
- "guile-cairo-1.4.1")))
+ "guile@2.0.9:debug"
+ "guile-cairo@1.4.1")))
(test-equal "integer"
'(1)
(string->duration "1m")
(string->duration "30d"))
+(test-equal "duration, 2 hours"
+ 7200
+ (time-second (string->duration "2h")))
+
+(test-equal "duration, 1 second"
+ (make-time time-duration 0 1)
+ (string->duration "1s"))
+
(test-equal "duration, integer"
#f
(string->duration "1"))
(inexact->exact (round (* 1.2 (expt 2 30))))
(size->number "1.2GiB"))
+(test-equal "size->number, 1T"
+ (expt 2 40)
+ (size->number "1T"))
+
+(test-equal "size->number, 1.M"
+ (expt 2 20)
+ (size->number "1.M"))
+
(test-assert "size->number, invalid unit"
(catch 'quit
(lambda ()
;; This should print nothing.
(show-what-to-build store (list drv)))))))
-(test-end "ui")
+(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 +1.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 +1.8.8 -> 2.0.9"
+ (with-error-to-string
+ (lambda ()
+ ;; In Guile 2.2, %DEFAULT-PORT-ENCODING doesn't
+ ;; influence the encoding of string ports.
+ (set-port-encoding! (current-error-port)
+ "ISO-8859-1")
+ (show-manifest-transaction store m t))))))))
+
+(test-assert "package-relevance"
+ (let ((guile (specification->package "guile"))
+ (gcrypt (specification->package "guile-gcrypt"))
+ (go (specification->package "go"))
+ (gnugo (specification->package "gnugo"))
+ (libb2 (specification->package "libb2"))
+ (rx (cut make-regexp <> regexp/icase))
+ (>0 (cut > <> 0))
+ (=0 zero?))
+ (and (>0 (package-relevance guile
+ (map rx '("scheme"))))
+ (>0 (package-relevance guile
+ (map rx '("scheme" "implementation"))))
+ (>0 (package-relevance gcrypt
+ (map rx '("guile" "crypto"))))
+ (=0 (package-relevance guile
+ (map rx '("guile" "crypto"))))
+ (>0 (package-relevance go
+ (map rx '("go"))))
+ (=0 (package-relevance go
+ (map rx '("go" "game"))))
+ (>0 (package-relevance gnugo
+ (map rx '("go" "game"))))
+ (>0 (package-relevance libb2
+ (map rx '("crypto" "library")))))))
+
+(define (make-empty-file directory file)
+ ;; Create FILE in DIRECTORY.
+ (close-port (open-output-file (in-vicinity directory file))))
+
+(define (assert-equals-find-available-pager expected)
+ ;; Use 'with-paginated-output-port' and return true if it invoked EXPECTED.
+ (define used-command "")
+ (mock ((ice-9 popen) open-pipe*
+ (lambda (mode command . args)
+ (unless (string-null? used-command)
+ (error "open-pipe* should only be called once"))
+ (set! used-command command)
+ (%make-void-port "")))
+ (mock ((ice-9 popen) close-pipe (const 'ok))
+ (mock ((guix colors) isatty?* (const #t))
+ (with-paginated-output-port port 'ok)
+ (string=? expected used-command)))))
+
+
+(test-assert "find-available-pager, GUIX_PAGER takes precedence"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-environment-variables `(("PATH" ,dir)
+ ("GUIX_PAGER" "guix-pager")
+ ("PAGER" "pager"))
+ (make-empty-file dir "less")
+ (make-empty-file dir "more")
+ (assert-equals-find-available-pager "guix-pager")))))
+
+(test-assert "find-available-pager, PAGER takes precedence"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-environment-variables `(("PATH" ,dir)
+ ("GUIX_PAGER" #false)
+ ("PAGER" "pager"))
+ (make-empty-file dir "less")
+ (make-empty-file dir "more")
+ (assert-equals-find-available-pager "pager")))))
+
+(test-assert "find-available-pager, 'less' takes precedence"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-environment-variables `(("PATH" ,dir)
+ ("GUIX_PAGER" #false)
+ ("PAGER" #false))
+ (make-empty-file dir "less")
+ (make-empty-file dir "more")
+ (assert-equals-find-available-pager (in-vicinity dir "less"))))))
+
+(test-assert "find-available-pager, 'more' takes precedence"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-environment-variables `(("PATH" ,dir)
+ ("GUIX_PAGER" #false)
+ ("PAGER" #false))
+ (make-empty-file dir "more")
+ (assert-equals-find-available-pager (in-vicinity dir "more"))))))
+
+(test-assert "find-available-pager, no pager"
+ (call-with-temporary-directory
+ (lambda (dir)
+ (with-environment-variables `(("PATH" ,dir)
+ ("GUIX_PAGER" #false)
+ ("PAGER" #false))
+ (assert-equals-find-available-pager "")))))
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
+(test-end "ui")
HCoop / jackhill / guix / guix.git / blobdiff