From 38b77f34640ff8a491913d29abcd16a846f2d0e4 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 20 Jan 2019 01:33:25 +0100
Subject: profiles: Allow a profile to be added as an entry of another profile.

* guix/build/profiles.scm (build-etc/profile): When 'OUTPUT/etc/profile'
already exists, delete it first.
(build-profile): Likewise for 'OUTPUT/manifest'.
* tests/profiles.scm ("profile in profile"): New test.
---
 guix/build/profiles.scm | 23 +++++++++++++++++++----
 tests/profiles.scm      | 32 +++++++++++++++++++++++++++++++-
 2 files changed, 50 insertions(+), 5 deletions(-)

diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm
index 0c23cd300e..1dc7976879 100644
--- a/guix/build/profiles.scm
+++ b/guix/build/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -67,8 +67,14 @@ user-friendly name of the profile is, for instance ~/.guix-profile rather than
 (define (build-etc/profile output search-paths)
   "Build the 'OUTPUT/etc/profile' shell file containing environment variable
 definitions for all the SEARCH-PATHS."
-  (mkdir-p (string-append output "/etc"))
-  (call-with-output-file (string-append output "/etc/profile")
+  (define file
+    (string-append output "/etc/profile"))
+
+  (mkdir-p (dirname file))
+  (when (file-exists? file)
+    (delete-file file))
+
+  (call-with-output-file file
     (lambda (port)
       ;; The use of $GUIX_PROFILE described below is not great.  Another
       ;; option would have been to use "$1" and have users run:
@@ -144,13 +150,22 @@ instead make DIRECTORY a \"real\" directory containing symlinks."
 create symlinks.  Write MANIFEST, an sexp, to OUTPUT/manifest.  Create
 OUTPUT/etc/profile with Bash definitions for -all the variables listed in
 SEARCH-PATHS."
+  (define manifest-file
+    (string-append output "/manifest"))
+
   ;; Make the symlinks.
   (union-build output inputs
                #:symlink symlink
                #:log-port (%make-void-port "w"))
 
+  ;; If one of the INPUTS provides a '/manifest' file, delete it.  That can
+  ;; happen if MANIFEST contains something such as a Guix instance, which is
+  ;; ultimately built as a profile.
+  (when (file-exists? manifest-file)
+    (delete-file manifest-file))
+
   ;; Store meta-data.
-  (call-with-output-file (string-append output "/manifest")
+  (call-with-output-file manifest-file
     (lambda (p)
       (pretty-print manifest p)))
 
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 8816839d16..9a05030aff 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.
@@ -591,6 +591,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:
-- 
cgit v1.2.3