summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2018-05-17 01:00:50 -0400
committerMark H Weaver <mhw@netris.org>2018-05-17 01:00:50 -0400
commit539bf8f2c071b53834829259bb3fabf0390c5dc6 (patch)
tree16672732afbf4c3f933e67ac677aa1877f6a7657 /tests
parent903874328ed5e5ab766e36cee1b1a0989e8b24a9 (diff)
parent2cf8531f360ef390d3ec670cc150b106bab5eff1 (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/graph.scm2
-rw-r--r--tests/guix-pack.sh10
-rw-r--r--tests/profiles.scm57
-rw-r--r--tests/union.scm18
-rw-r--r--tests/utils.scm8
5 files changed, 84 insertions, 11 deletions
diff --git a/tests/graph.scm b/tests/graph.scm
index 5faa19298a..b86ae4a32f 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -134,7 +134,7 @@ edges."
(map (lambda (destination)
(list "p-0.drv"
(string-append
- (package-full-name destination)
+ (package-full-name destination "-")
".drv")))
implicit)))))))
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index 5584c10e00..130389a7ad 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -20,9 +20,9 @@
# Test the `guix pack' command-line utility.
#
-# A network connection is required to build %bootstrap-coreutils&co,
-# which is required to run these tests with the --bootstrap option.
-if ! guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null; then
+# The bootstrap binaries are needed to run these tests, which usually requires
+# a network connection.
+if ! guix build -q guile-bootstrap; then
exit 77
fi
@@ -87,6 +87,10 @@ guix pack --dry-run --bootstrap -f docker -S /opt/gnu=/ guile-bootstrap
# guile-bootstrap is not intended to be cross-compiled.
guix pack --dry-run --bootstrap --target=arm-unknown-linux-gnueabihf coreutils
+# Likewise, 'guix pack -R' requires a full-blown toolchain (because
+# 'glibc-bootstrap' lacks 'libc.a'), hence '--dry-run'.
+guix pack -R --dry-run --bootstrap -S /mybin=bin guile-bootstrap
+
# Make sure package transformation options are honored.
mkdir -p "$test_directory"
drv1="`guix pack -n guile 2>&1 | grep pack.*\.drv`"
diff --git a/tests/profiles.scm b/tests/profiles.scm
index eba79d4e31..3a59a0cc4f 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -223,6 +223,52 @@
(string=? (dirname (readlink bindir))
(derivation->output-path guile))))))
+(test-assertm "profile-derivation relative symlinks, one entry"
+ (mlet* %store-monad
+ ((entry -> (package->manifest-entry %bootstrap-guile))
+ (guile (package->derivation %bootstrap-guile))
+ (drv (profile-derivation (manifest (list entry))
+ #:relative-symlinks? #t
+ #:hooks '()
+ #:locales? #f))
+ (profile -> (derivation->output-path drv))
+ (bindir -> (string-append profile "/bin"))
+ (_ (built-derivations (list drv))))
+ (return (and (file-exists? (string-append bindir "/guile"))
+ (string=? (readlink bindir)
+ (string-append "../"
+ (basename
+ (derivation->output-path guile))
+ "/bin"))))))
+
+(unless (network-reachable?) (test-skip 1))
+(test-assertm "profile-derivation relative symlinks, two entries"
+ (mlet* %store-monad
+ ((gnu-make-boot0 -> (@@ (gnu packages commencement) gnu-make-boot0))
+ (manifest -> (packages->manifest
+ (list %bootstrap-guile gnu-make-boot0)))
+ (guile (package->derivation %bootstrap-guile))
+ (make (package->derivation gnu-make-boot0))
+ (drv (profile-derivation manifest
+ #:relative-symlinks? #t
+ #:hooks '()
+ #:locales? #f))
+ (profile -> (derivation->output-path drv))
+ (bindir -> (string-append profile "/bin"))
+ (_ (built-derivations (list drv))))
+ (return (and (file-exists? (string-append bindir "/guile"))
+ (file-exists? (string-append bindir "/make"))
+ (string=? (readlink (string-append bindir "/guile"))
+ (string-append "../../"
+ (basename
+ (derivation->output-path guile))
+ "/bin/guile"))
+ (string=? (readlink (string-append bindir "/make"))
+ (string-append "../../"
+ (basename
+ (derivation->output-path make))
+ "/bin/make"))))))
+
(test-assertm "profile-derivation, inputs"
(mlet* %store-monad
((entry -> (package->manifest-entry packages:glibc "debug"))
@@ -242,8 +288,8 @@
#:hooks '()
#:locales? #t
#:target target)))
- (define (find-input name)
- (let ((name (string-append name ".drv")))
+ (define (find-input package)
+ (let ((name (string-append (package-full-name package "-") ".drv")))
(any (lambda (input)
(let ((input (derivation-input-path input)))
(and (string-suffix? name input) input)))
@@ -252,12 +298,11 @@
;; The inputs for grep and sed should be cross-build derivations, but that
;; for the glibc-utf8-locales should be a native build.
(return (and (string=? (derivation-system drv) (%current-system))
- (string=? (find-input (package-full-name packages:grep))
+ (string=? (find-input packages:grep)
(derivation-file-name grep))
- (string=? (find-input (package-full-name packages:sed))
+ (string=? (find-input packages:sed)
(derivation-file-name sed))
- (string=? (find-input
- (package-full-name packages:glibc-utf8-locales))
+ (string=? (find-input packages:glibc-utf8-locales)
(derivation-file-name locales))))))
(test-assert "package->manifest-entry defaults to \"out\""
diff --git a/tests/union.scm b/tests/union.scm
index aa95cae001..5a6a4033fc 100644
--- a/tests/union.scm
+++ b/tests/union.scm
@@ -184,4 +184,22 @@
(file-is-directory? "bin")
(eq? 'symlink (stat:type (lstat "bin/guile"))))))))
+(letrec-syntax ((test-relative-file-name
+ (syntax-rules (=>)
+ ((_ (reference file => expected) rest ...)
+ (begin
+ (test-equal (string-append "relative-file-name "
+ reference " " file)
+ expected
+ (relative-file-name reference file))
+ (test-relative-file-name rest ...)))
+ ((_)
+ #t))))
+ (test-relative-file-name
+ ("/a/b" "/a/c/d" => "../c/d")
+ ("/a/b" "/a/b" => "")
+ ("/a/b" "/a" => "..")
+ ("/a/b" "/a/b/c/d" => "c/d")
+ ("/a/b/c" "/a/d/e/f" => "../../d/e/f")))
+
(test-end)
diff --git a/tests/utils.scm b/tests/utils.scm
index 035886dd16..3015b21b23 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;;
@@ -72,6 +72,12 @@
(test-assert "guile-version>? 10.5"
(not (guile-version>? "10.5")))
+(test-assert "version-prefix?"
+ (and (version-prefix? "4.1" "4.1.2")
+ (version-prefix? "4.1" "4.1")
+ (not (version-prefix? "4.1" "4.16.2"))
+ (not (version-prefix? "4.1" "4"))))
+
(test-equal "string-tokenize*"
'(("foo")
("foo" "bar" "baz")