summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2015-07-15 15:10:32 -0400
committerMark H Weaver <mhw@netris.org>2015-07-15 15:10:32 -0400
commit35995769b516d228793940c5333ad522de992a6c (patch)
tree366b81995e9afbf8f94ecf7d4237b325ec07a0a1 /tests
parentc6f909809aecb225b66dc27e4afd3ff46ec31a38 (diff)
parente03f6d5e956b348c142d0ffd9f89af845f05eb86 (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/derivations.scm9
-rw-r--r--tests/file-systems.scm46
-rw-r--r--tests/guix-daemon.sh12
-rw-r--r--tests/store.scm51
-rw-r--r--tests/syscalls.scm6
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)