diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/derivations.scm | 80 | ||||
| -rw-r--r-- | tests/grafts.scm | 16 | ||||
| -rw-r--r-- | tests/guix-daemon.sh | 2 | ||||
| -rw-r--r-- | tests/packages.scm | 32 | ||||
| -rw-r--r-- | tests/syscalls.scm | 5 | ||||
| -rw-r--r-- | tests/ui.scm | 27 |
6 files changed, 113 insertions, 49 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm index 93f4cdd8ee..d173a78906 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -87,9 +87,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)))) @@ -724,7 +726,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)))) @@ -741,7 +743,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))))) @@ -805,17 +807,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)) @@ -828,9 +833,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)) @@ -839,9 +847,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))) @@ -853,17 +862,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) @@ -876,16 +887,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) @@ -898,7 +909,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>. @@ -907,7 +919,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) @@ -919,13 +931,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 f85f3c6913..6fd3d5e171 100644 --- a/tests/grafts.scm +++ b/tests/grafts.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> ;;; ;;; This file is part of GNU Guix. ;;; @@ -45,9 +45,6 @@ (define %mkdir (bootstrap-binary "mkdir")) -(define make-derivation-input - (@@ (guix derivations) make-derivation-input)) - (test-begin "grafts") @@ -356,16 +353,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 ce82cfd1e6..78f82eafe2 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 613b2f1221..836d446657 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1227,6 +1227,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") |