Merge branch 'master' into core-updates

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")