aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-06-27 23:33:48 +0200
committerLudovic Courtès <ludo@gnu.org>2019-06-27 23:33:48 +0200
commit5cc1075a76392666d3d733837f5c6252b1e48002 (patch)
treeaff2a303881a6fe53021a6e78a767958e608719b /tests
parent9c2563a80b6f1d8fb8677f5314e6180ea9916aa5 (diff)
parentc30d117822a8ca26cd8c06c0a3974955bef68eac (diff)
downloadguix-5cc1075a76392666d3d733837f5c6252b1e48002.tar
guix-5cc1075a76392666d3d733837f5c6252b1e48002.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/derivations.scm80
-rw-r--r--tests/grafts.scm14
-rw-r--r--tests/guix-daemon.sh2
-rw-r--r--tests/packages.scm32
-rw-r--r--tests/syscalls.scm5
-rw-r--r--tests/ui.scm27
6 files changed, 112 insertions, 48 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm
index b0175d9fc5..98018a45e3 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -86,9 +86,11 @@
(test-assert "parse & export"
(let* ((f (search-path %load-path "tests/test.drv"))
(b1 (call-with-input-file f get-bytevector-all))
- (d1 (read-derivation (open-bytevector-input-port b1)))
+ (d1 (read-derivation (open-bytevector-input-port b1)
+ identity))
(b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
- (d2 (read-derivation (open-bytevector-input-port b2))))
+ (d2 (read-derivation (open-bytevector-input-port b2)
+ identity)))
(and (equal? b1 b2)
(equal? d1 d2))))
@@ -723,7 +725,7 @@
(test-assert "build-expression->derivation and derivation-prerequisites"
(let ((drv (build-expression->derivation %store "fail" #f)))
(any (match-lambda
- (($ <derivation-input> path)
+ (($ <derivation-input> (= derivation-file-name path))
(string=? path (derivation-file-name (%guile-for-build)))))
(derivation-prerequisites drv))))
@@ -740,7 +742,7 @@
(match (derivation-prerequisites c
(cut valid-derivation-input? %store
<>))
- ((($ <derivation-input> file ("out")))
+ ((($ <derivation-input> (= derivation-file-name file) ("out")))
(string=? file (derivation-file-name b)))
(x
(pk 'fail x #f)))))
@@ -804,17 +806,20 @@
;; Ask for nothing but the "out" output of DRV.
(build-derivations store `((,drv . "out")))
+ ;; Synonymous:
+ (build-derivations store (list (derivation-input drv '("out"))))
+
(valid-path? store out)
- (equal? (pk 'x content) (pk 'y (call-with-input-file out get-string-all)))
- )))))
+ (equal? (pk 'x content)
+ (pk 'y (call-with-input-file out get-string-all))))))))
-(test-assert "build-expression->derivation and derivation-prerequisites-to-build"
+(test-assert "build-expression->derivation and derivation-build-plan"
(let ((drv (build-expression->derivation %store "fail" #f)))
;; The only direct dependency is (%guile-for-build) and it's already
;; built.
- (null? (derivation-prerequisites-to-build %store drv))))
+ (null? (derivation-build-plan %store (derivation-inputs drv)))))
-(test-assert "derivation-prerequisites-to-build when outputs already present"
+(test-assert "derivation-build-plan when outputs already present"
(let* ((builder `(begin ,(random-text) (mkdir %output) #t))
(input-drv (build-expression->derivation %store "input" builder))
(input-path (derivation->output-path input-drv))
@@ -827,9 +832,12 @@
(valid-path? %store output))
(error "things already built" input-drv))
- (and (equal? (map derivation-input-path
- (derivation-prerequisites-to-build %store drv))
- (list (derivation-file-name input-drv)))
+ (and (lset= equal?
+ (map derivation-file-name
+ (derivation-build-plan %store
+ (list (derivation-input drv))))
+ (list (derivation-file-name input-drv)
+ (derivation-file-name drv)))
;; Build DRV and delete its input.
(build-derivations %store (list drv))
@@ -838,9 +846,10 @@
;; Now INPUT-PATH is missing, yet it shouldn't be listed as a
;; prerequisite to build because DRV itself is already built.
- (null? (derivation-prerequisites-to-build %store drv)))))
+ (null? (derivation-build-plan %store
+ (list (derivation-input drv)))))))
-(test-assert "derivation-prerequisites-to-build and substitutes"
+(test-assert "derivation-build-plan and substitutes"
(let* ((store (open-connection))
(drv (build-expression->derivation store "prereq-subst"
(random 1000)))
@@ -852,17 +861,19 @@
(with-derivation-narinfo drv
(let-values (((build download)
- (derivation-prerequisites-to-build store drv))
+ (derivation-build-plan store
+ (list (derivation-input drv))))
((build* download*)
- (derivation-prerequisites-to-build store drv
- #:substitutable-info
- (const #f))))
+ (derivation-build-plan store
+ (list (derivation-input drv))
+ #:substitutable-info
+ (const #f))))
(and (null? build)
(equal? (map substitutable-path download) (list output))
(null? download*)
- (null? build*))))))
+ (equal? (list drv) build*))))))
-(test-assert "derivation-prerequisites-to-build and substitutes, non-substitutable build"
+(test-assert "derivation-build-plan and substitutes, non-substitutable build"
(let* ((store (open-connection))
(drv (build-expression->derivation store "prereq-no-subst"
(random 1000)
@@ -875,16 +886,16 @@
(with-derivation-narinfo drv
(let-values (((build download)
- (derivation-prerequisites-to-build store drv)))
+ (derivation-build-plan store
+ (list (derivation-input drv)))))
;; Despite being available as a substitute, DRV will be built locally
;; due to #:substitutable? #f.
(and (null? download)
(match build
- (((? derivation-input? input))
- (string=? (derivation-input-path input)
- (derivation-file-name drv)))))))))
+ (((= derivation-file-name build))
+ (string=? build (derivation-file-name drv)))))))))
-(test-assert "derivation-prerequisites-to-build and substitutes, local build"
+(test-assert "derivation-build-plan and substitutes, local build"
(with-store store
(let* ((drv (build-expression->derivation store "prereq-subst-local"
(random 1000)
@@ -897,7 +908,8 @@
(with-derivation-narinfo drv
(let-values (((build download)
- (derivation-prerequisites-to-build store drv)))
+ (derivation-build-plan store
+ (list (derivation-input drv)))))
;; #:local-build? is *not* synonymous with #:substitutable?, so we
;; must be able to substitute DRV's output.
;; See <http://bugs.gnu.org/18747>.
@@ -906,7 +918,7 @@
(((= substitutable-path item))
(string=? item (derivation->output-path drv))))))))))
-(test-assert "derivation-prerequisites-to-build in 'check' mode"
+(test-assert "derivation-build-plan in 'check' mode"
(with-store store
(let* ((dep (build-expression->derivation store "dep"
`(begin ,(random-text)
@@ -918,13 +930,13 @@
(delete-paths store (list (derivation->output-path dep)))
;; In 'check' mode, DEP must be rebuilt.
- (and (null? (derivation-prerequisites-to-build store drv))
- (match (derivation-prerequisites-to-build store drv
- #:mode (build-mode
- check))
- ((input)
- (string=? (derivation-input-path input)
- (derivation-file-name dep))))))))
+ (and (null? (derivation-build-plan store
+ (list (derivation-input drv))))
+ (lset= equal?
+ (derivation-build-plan store
+ (list (derivation-input drv))
+ #:mode (build-mode check))
+ (list drv dep))))))
(test-assert "substitution-oracle and #:substitute? #f"
(with-store store
diff --git a/tests/grafts.scm b/tests/grafts.scm
index e5356decc5..a12c6a5911 100644
--- a/tests/grafts.scm
+++ b/tests/grafts.scm
@@ -44,9 +44,6 @@
(define %mkdir
(bootstrap-binary "mkdir"))
-(define make-derivation-input
- (@@ (guix derivations) make-derivation-input))
-
(test-begin "grafts")
@@ -355,16 +352,11 @@
(p1r-inputs (filter (match-input p1r) inputs))
(p2-inputs (filter (match-input p2) inputs)))
(and (equal? p1-inputs
- (list (make-derivation-input (derivation-file-name p1)
- '("one"))))
+ (list (derivation-input p1 '("one"))))
(equal? p1r-inputs
- (list
- (make-derivation-input (derivation-file-name p1r)
- '("ONE"))))
+ (list (derivation-input p1r '("ONE"))))
(equal? p2-inputs
- (list
- (make-derivation-input (derivation-file-name p2)
- '("aaa"))))
+ (list (derivation-input p2 '("aaa"))))
(derivation-output-names p2g))))))
(test-assert "graft-derivation, renaming" ;<http://bugs.gnu.org/23132>
diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh
index ca46e34ce9..758f18cc36 100644
--- a/tests/guix-daemon.sh
+++ b/tests/guix-daemon.sh
@@ -196,7 +196,7 @@ done
# Make sure garbage collection from a TCP connection does not work.
-tcp_socket="127.0.0.1:9999"
+tcp_socket="127.0.0.1:9998"
guix-daemon --listen="$tcp_socket" &
daemon_pid=$!
diff --git a/tests/packages.scm b/tests/packages.scm
index bd100bea5b..0478fff237 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1244,6 +1244,38 @@
(lambda (key . args)
key)))
+(test-equal "specification->package+output"
+ `((,coreutils "out") (,coreutils "debug"))
+ (list (call-with-values (lambda ()
+ (specification->package+output "coreutils"))
+ list)
+ (call-with-values (lambda ()
+ (specification->package+output "coreutils:debug"))
+ list)))
+
+(test-equal "specification->package+output invalid output"
+ 'error
+ (catch 'quit
+ (lambda ()
+ (specification->package+output "coreutils:does-not-exist"))
+ (lambda _
+ 'error)))
+
+(test-equal "specification->package+output no default output"
+ `(,coreutils #f)
+ (call-with-values
+ (lambda ()
+ (specification->package+output "coreutils" #f))
+ list))
+
+(test-equal "specification->package+output invalid output, no default"
+ 'error
+ (catch 'quit
+ (lambda ()
+ (specification->package+output "coreutils:does-not-exist" #f))
+ (lambda _
+ 'error)))
+
(test-equal "find-package-locations"
(map (lambda (package)
(cons (package-version package)
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 3e267c9f01..eeb223b950 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;;
;;; This file is part of GNU Guix.
@@ -538,6 +538,9 @@
(> (terminal-columns (open-input-string "Join us now, share the software!"))
0))
+(test-assert "terminal-rows"
+ (> (terminal-rows) 0))
+
(test-assert "utmpx-entries"
(match (utmpx-entries)
(((? utmpx? entries) ...)
diff --git a/tests/ui.scm b/tests/ui.scm
index 1e98e3534b..2138e23369 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,10 +22,12 @@
#: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 (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
#:use-module (ice-9 regex))
@@ -260,4 +262,27 @@ Second line" 24))
"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"))
+ (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")))))))
+
(test-end "ui")