X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/539bf8f2c071b53834829259bb3fabf0390c5dc6..0f0bffc4bd054336b977f765897508716a3d1d60:/tests/profiles.scm

diff --git a/tests/profiles.scm b/tests/profiles.scm
index 3a59a0cc4f..a4e28672b5 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -20,6 +20,7 @@
 (define-module (test-profiles)
   #:use-module (guix tests)
   #:use-module (guix profiles)
+  #:use-module (guix gexp)
   #:use-module (guix store)
   #:use-module (guix monads)
   #:use-module (guix grafts)
@@ -46,17 +47,6 @@
 ;; Globally disable grafts because they can trigger early builds.
 (%graft? #f)
 
-(define-syntax-rule (test-assertm name exp)
-  (test-assert name
-    (run-with-store %store exp
-                    #:guile-for-build (%guile-for-build))))
-
-(define-syntax-rule (test-equalm name value exp)
-  (test-equal name
-    value
-    (run-with-store %store exp
-                    #:guile-for-build (%guile-for-build))))
-
 ;; Example manifest entries.
 
 (define guile-1.8.8
@@ -103,10 +93,7 @@
 (test-assert "manifest-matching-entries"
   (let* ((e (list guile-2.0.9 guile-2.0.9:debug))
          (m (manifest e)))
-    (and (null? (manifest-matching-entries m
-                                           (list (manifest-pattern
-                                                   (name "python")))))
-         (equal? e
+    (and (equal? e
                  (manifest-matching-entries m
                                             (list (manifest-pattern
                                                     (name "guile")
@@ -117,6 +104,15 @@
                                                     (name "guile")
                                                     (version "2.0.9"))))))))
 
+(test-assert "manifest-matching-entries, no match"
+  (let ((m (manifest (list guile-2.0.9)))
+        (p (manifest-pattern (name "python"))))
+    (guard (c ((unmatched-pattern-error? c)
+               (and (eq? p (unmatched-pattern-error-pattern c))
+                    (eq? m (unmatched-pattern-error-manifest c)))))
+      (manifest-matching-entries m (list p))
+      #f)))
+
 (test-assert "manifest-remove"
   (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
          (m1 (manifest-remove m0
@@ -175,8 +171,7 @@
 (test-assert "manifest-transaction-effects"
   (let* ((m0 (manifest (list guile-1.8.8)))
          (t  (manifest-transaction
-              (install (list guile-2.0.9 glibc))
-              (remove (list (manifest-pattern (name "coreutils")))))))
+              (install (list guile-2.0.9 glibc)))))
     (let-values (((remove install upgrade downgrade)
                   (manifest-transaction-effects m0 t)))
       (and (null? remove) (null? downgrade)
@@ -244,11 +239,10 @@
 (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)))
+      ((manifest -> (packages->manifest
+                     (list %bootstrap-guile gnu-make-for-tests)))
        (guile       (package->derivation %bootstrap-guile))
-       (make        (package->derivation gnu-make-boot0))
+       (make        (package->derivation gnu-make-for-tests))
        (drv         (profile-derivation manifest
                                         #:relative-symlinks? #t
                                         #:hooks '()
@@ -340,7 +334,7 @@
 
 (test-assert "package->manifest-entry, search paths"
   ;; See <http://bugs.gnu.org/22073>.
-  (let ((mpl (@ (gnu packages python) python2-matplotlib)))
+  (let ((mpl (@ (gnu packages python-xyz) python2-matplotlib)))
     (lset= eq?
            (package-transitive-native-search-paths mpl)
            (manifest-entry-search-paths
@@ -543,6 +537,41 @@
                                get-string-all)
                              "foo!"))))))
 
+(test-assertm "profile-derivation when etc/ is a relative symlink"
+  ;; See <https://bugs.gnu.org/32686>.
+  (mlet* %store-monad
+      ((etc        (gexp->derivation
+                    "etc"
+                    #~(begin
+                        (mkdir #$output)
+                        (call-with-output-file (string-append #$output "/foo")
+                          (lambda (port)
+                            (display "Heya!" port))))))
+       (thing ->   (dummy-package "dummy"
+                     (build-system trivial-build-system)
+                     (inputs
+                      `(("etc" ,etc)))
+                     (arguments
+                      `(#:guile ,%bootstrap-guile
+                        #:builder
+                        (let ((out (assoc-ref %outputs "out"))
+                              (etc (assoc-ref %build-inputs "etc")))
+                          (mkdir out)
+                          (symlink etc (string-append out "/etc"))
+                          #t)))))
+       (entry ->   (package->manifest-entry thing))
+       (drv        (profile-derivation (manifest (list entry))
+                                       #:relative-symlinks? #t
+                                       #:hooks '()
+                                       #:locales? #f))
+       (profile -> (derivation->output-path drv)))
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (return (string=? (call-with-input-file
+                            (string-append profile "/etc/foo")
+                          get-string-all)
+                        "Heya!")))))
+
 (test-equalm "union vs. dangling symlink"        ;<https://bugs.gnu.org/26949>
   "does-not-exist"
   (mlet* %store-monad
@@ -566,6 +595,36 @@
       (built-derivations (list drv))
       (return (readlink (readlink (string-append profile "/dangling")))))))
 
+(test-equalm "profile in profile"
+  '("foo" "0")
+
+  ;; Make sure we can build a profile that has another profile has one of its
+  ;; entries.  The new profile's /manifest and /etc/profile must override the
+  ;; other's.
+  (mlet* %store-monad
+      ((prof0 (profile-derivation
+               (manifest
+                (list (package->manifest-entry %bootstrap-guile)))
+               #:hooks '()
+               #:locales? #f))
+       (prof1 (profile-derivation
+               (manifest (list (manifest-entry
+                                 (name "foo")
+                                 (version "0")
+                                 (item prof0))))
+               #:hooks '()
+               #:locales? #f)))
+    (mbegin %store-monad
+      (built-derivations (list prof1))
+      (let ((out (derivation->output-path prof1)))
+        (return (and (file-exists?
+                      (string-append out "/bin/guile"))
+                     (let ((manifest (profile-manifest out)))
+                       (match (manifest-entries manifest)
+                         ((entry)
+                          (list (manifest-entry-name entry)
+                                (manifest-entry-version entry)))))))))))
+
 (test-end "profiles")
 
 ;;; Local Variables: