diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/derivations.scm | 9 | ||||
| -rw-r--r-- | tests/file-systems.scm | 46 | ||||
| -rw-r--r-- | tests/guix-daemon.sh | 12 | ||||
| -rw-r--r-- | tests/store.scm | 51 | ||||
| -rw-r--r-- | tests/syscalls.scm | 6 |
5 files changed, 108 insertions, 16 deletions
diff --git a/tests/derivations.scm b/tests/derivations.scm index f66ef5cdd7..d2a090c8bc 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -612,7 +612,8 @@ (output (derivation->output-path drv))) ;; Make sure substitutes are usable. - (set-build-options store #:use-substitutes? #t) + (set-build-options store #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (with-derivation-narinfo drv (let-values (((build download) @@ -634,7 +635,8 @@ (output (derivation->output-path drv))) ;; Make sure substitutes are usable. - (set-build-options store #:use-substitutes? #t) + (set-build-options store #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (with-derivation-narinfo drv (let-values (((build download) @@ -655,7 +657,8 @@ (output (derivation->output-path drv))) ;; Make sure substitutes are usable. - (set-build-options store #:use-substitutes? #t) + (set-build-options store #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (with-derivation-narinfo drv (let-values (((build download) diff --git a/tests/file-systems.scm b/tests/file-systems.scm new file mode 100644 index 0000000000..d445b4971f --- /dev/null +++ b/tests/file-systems.scm @@ -0,0 +1,46 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (test-file-systems) + #:use-module (gnu system file-systems) + #:use-module (srfi srfi-64) + #:use-module (rnrs bytevectors)) + +;; Test the (gnu system file-systems) module. + +(test-begin "file-systems") + +(test-equal "uuid->string" + "c5307e6b-d1ba-499d-89c5-cb0b143577c4" + (uuid->string + #vu8(197 48 126 107 209 186 73 157 137 197 203 11 20 53 119 196))) + +(test-equal "string->uuid" + '(16 "4dab5feb-d176-45de-b287-9b0a6e4c01cb") + (let ((uuid (string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))) + (list (bytevector-length uuid) (uuid->string uuid)))) + +(test-assert "uuid" + (let ((str "4dab5feb-d176-45de-b287-9b0a6e4c01cb")) + (bytevector=? (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb") + (string->uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))) + +(test-end) + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) diff --git a/tests/guix-daemon.sh b/tests/guix-daemon.sh index 87f17def12..0de6f278e4 100644 --- a/tests/guix-daemon.sh +++ b/tests/guix-daemon.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2014 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2012, 2014, 2015 Ludovic Courtès <ludo@gnu.org> # # This file is part of GNU Guix. # @@ -54,11 +54,12 @@ EOF rm -f "$XDG_CACHE_HOME/guix/substitute/$hash_part" # Make sure we see the substitute. -guile -c ' +guile -c " (use-modules (guix)) (define store (open-connection)) - (set-build-options store #:use-substitutes? #t) - (exit (has-substitutes? store "'"$out"'"))' + (set-build-options store #:use-substitutes? #t + #:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\")) + (exit (has-substitutes? store \"$out\"))" # Now, run guix-daemon --no-substitutes. socket="$NIX_STATE_DIR/alternate-socket" @@ -72,6 +73,7 @@ guile -c " (define store (open-connection \"$socket\")) ;; This setting MUST NOT override the daemon's --no-substitutes. - (set-build-options store #:use-substitutes? #t) + (set-build-options store #:use-substitutes? #t + #:substitute-urls (list \"$GUIX_BINARY_SUBSTITUTE_URL\")) (exit (not (has-substitutes? store \"$out\")))" diff --git a/tests/store.scm b/tests/store.scm index faa924fce9..96b64781dd 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -25,6 +25,7 @@ #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix serialization) + #:use-module (guix build utils) #:use-module (guix gexp) #:use-module (gnu packages) #:use-module (gnu packages bootstrap) @@ -371,13 +372,13 @@ (with-derivation-narinfo d ;; Remove entry from the local cache. (false-if-exception - (delete-file (string-append (getenv "XDG_CACHE_HOME") - "/guix/substitute/" - (store-path-hash-part o)))) + (delete-file-recursively (string-append (getenv "XDG_CACHE_HOME") + "/guix/substitute"))) ;; Make sure 'guix substitute' correctly communicates the above ;; data. - (set-build-options s #:use-substitutes? #t) + (set-build-options s #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (and (has-substitutes? s o) (equal? (list o) (substitutable-paths s (list o))) (match (pk 'spi (substitutable-path-info s (list o))) @@ -387,6 +388,34 @@ (null? (substitutable-references s)) (equal? (substitutable-nar-size s) 1234))))))))) +(test-assert "substitute query, alternating URLs" + (let* ((d (with-store s + (package-derivation s %bootstrap-guile (%current-system)))) + (o (derivation->output-path d))) + (with-derivation-narinfo d + ;; Remove entry from the local cache. + (false-if-exception + (delete-file-recursively (string-append (getenv "XDG_CACHE_HOME") + "/guix/substitute"))) + + ;; Note: We reconnect to the daemon to force a new instance of 'guix + ;; substitute' to be used; otherwise the #:substitute-urls of + ;; 'set-build-options' would have no effect. + + (and (with-store s ;the right substitute URL + (set-build-options s #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) + (has-substitutes? s o)) + (with-store s ;the wrong one + (set-build-options s #:use-substitutes? #t + #:substitute-urls (list + "http://does-not-exist")) + (not (has-substitutes? s o))) + (with-store s ;the right one again + (set-build-options s #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) + (has-substitutes? s o)))))) + (test-assert "substitute" (with-store s (let* ((c (random-text)) ; contents of the output @@ -400,7 +429,8 @@ (package-derivation s %bootstrap-guile (%current-system)))) (o (derivation->output-path d))) (with-derivation-substitute d c - (set-build-options s #:use-substitutes? #t) + (set-build-options s #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (and (has-substitutes? s o) (build-derivations s (list d)) (equal? c (call-with-input-file o get-string-all))))))) @@ -418,7 +448,8 @@ (package-derivation s %bootstrap-guile (%current-system)))) (o (derivation->output-path d))) (with-derivation-substitute d c - (set-build-options s #:use-substitutes? #t) + (set-build-options s #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (and (has-substitutes? s o) (build-things s (list o)) ;give the output path (valid-path? s o) @@ -442,7 +473,8 @@ ;; Make sure we use 'guix substitute'. (set-build-options s #:use-substitutes? #t - #:fallback? #f) + #:fallback? #f + #:substitute-urls (%test-substitute-urls)) (and (has-substitutes? s o) (guard (c ((nix-protocol-error? c) ;; XXX: the daemon writes "hash mismatch in downloaded @@ -467,13 +499,16 @@ ;; Create fake substituter data, to be read by 'guix substitute'. (with-derivation-narinfo d ;; Make sure we use 'guix substitute'. - (set-build-options s #:use-substitutes? #t) + (set-build-options s #:use-substitutes? #t + #:substitute-urls (%test-substitute-urls)) (and (has-substitutes? s o) (guard (c ((nix-protocol-error? c) ;; The substituter failed as expected. Now make ;; sure that #:fallback? #t works correctly. (set-build-options s #:use-substitutes? #t + #:substitute-urls + (%test-substitute-urls) #:fallback? #t) (and (build-derivations s (list d)) (equal? t (call-with-input-file o diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 8598f747f1..6b614a5211 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -80,6 +80,8 @@ (define (user-namespace pid) (string-append "/proc/" (number->string pid) "/ns/user")) +(unless (file-exists? (user-namespace (getpid))) + (test-skip 1)) (test-assert "clone" (match (clone (logior CLONE_NEWUSER SIGCHLD)) (0 (primitive-exit 42)) @@ -91,6 +93,8 @@ ((_ . status) (= 42 (status:exit-val status)))))))) +(unless (file-exists? (user-namespace (getpid))) + (test-skip 1)) (test-assert "setns" (match (clone (logior CLONE_NEWUSER SIGCHLD)) (0 (primitive-exit 0)) @@ -118,6 +122,8 @@ (waitpid fork-pid) result)))))))) +(unless (file-exists? (user-namespace (getpid))) + (test-skip 1)) (test-assert "pivot-root" (match (pipe) ((in . out) |