tests/profiles.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (test-profiles)
  21   #:use-module (guix tests)
  22   #:use-module (guix profiles)
  23   #:use-module (guix gexp)
  24   #:use-module (guix store)
  25   #:use-module (guix monads)
  26   #:use-module (guix grafts)
  27   #:use-module (guix packages)
  28   #:use-module (guix derivations)
  29   #:use-module (guix build-system trivial)
  30   #:use-module (gnu packages bootstrap)
  31   #:use-module ((gnu packages base) #:prefix packages:)
  32   #:use-module ((gnu packages guile) #:prefix packages:)
  33   #:use-module (ice-9 match)
  34   #:use-module (ice-9 regex)
  35   #:use-module (ice-9 popen)
  36   #:use-module (rnrs io ports)
  37   #:use-module (srfi srfi-1)
  38   #:use-module (srfi srfi-11)
  39   #:use-module (srfi srfi-34)
  40   #:use-module (srfi srfi-64))
  41
  42 ;; Test the (guix profiles) module.
  43
  44 (define %store
  45   (open-connection-for-tests))
  46
  47 ;; Globally disable grafts because they can trigger early builds.
  48 (%graft? #f)
  49
  50 ;; Example manifest entries.
  51
  52 (define guile-1.8.8
  53   (manifest-entry
  54     (name "guile")
  55     (version "1.8.8")
  56     (item "/gnu/store/...")
  57     (output "out")))
  58
  59 (define guile-2.0.9
  60   (manifest-entry
  61     (name "guile")
  62     (version "2.0.9")
  63     (item "/gnu/store/...")
  64     (output "out")))
  65
  66 (define guile-2.0.9:debug
  67   (manifest-entry (inherit guile-2.0.9)
  68     (output "debug")))
  69
  70 (define glibc
  71   (manifest-entry
  72     (name "glibc")
  73     (version "2.19")
  74     (item "/gnu/store/...")
  75     (output "out")))
  76
  77 \f
  78 (test-begin "profiles")
  79
  80 (test-assert "manifest-installed?"
  81   (let ((m (manifest (list guile-2.0.9 guile-2.0.9:debug))))
  82     (and (manifest-installed? m (manifest-pattern (name "guile")))
  83          (manifest-installed? m (manifest-pattern
  84                                   (name "guile") (output "debug")))
  85          (manifest-installed? m (manifest-pattern
  86                                   (name "guile") (output "out")
  87                                   (version "2.0.9")))
  88          (not (manifest-installed?
  89                m (manifest-pattern (name "guile") (version "1.8.8"))))
  90          (not (manifest-installed?
  91                m (manifest-pattern (name "guile") (output "foobar")))))))
  92
  93 (test-assert "manifest-matching-entries"
  94   (let* ((e (list guile-2.0.9 guile-2.0.9:debug))
  95          (m (manifest e)))
  96     (and (equal? e
  97                  (manifest-matching-entries m
  98                                             (list (manifest-pattern
  99                                                     (name "guile")
 100                                                     (output #f)))))
 101          (equal? (list guile-2.0.9)
 102                  (manifest-matching-entries m
 103                                             (list (manifest-pattern
 104                                                     (name "guile")
 105                                                     (version "2.0.9"))))))))
 106
 107 (test-assert "manifest-matching-entries, no match"
 108   (let ((m (manifest (list guile-2.0.9)))
 109         (p (manifest-pattern (name "python"))))
 110     (guard (c ((unmatched-pattern-error? c)
 111                (and (eq? p (unmatched-pattern-error-pattern c))
 112                     (eq? m (unmatched-pattern-error-manifest c)))))
 113       (manifest-matching-entries m (list p))
 114       #f)))
 115
 116 (test-assert "manifest-remove"
 117   (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
 118          (m1 (manifest-remove m0
 119                               (list (manifest-pattern (name "guile")))))
 120          (m2 (manifest-remove m1
 121                               (list (manifest-pattern (name "guile"))))) ; same
 122          (m3 (manifest-remove m2
 123                               (list (manifest-pattern
 124                                       (name "guile") (output "debug")))))
 125          (m4 (manifest-remove m3
 126                               (list (manifest-pattern (name "guile"))))))
 127     (match (manifest-entries m2)
 128       ((($ <manifest-entry> "guile" "2.0.9" "debug"))
 129        (and (equal? m1 m2)
 130             (null? (manifest-entries m3))
 131             (null? (manifest-entries m4)))))))
 132
 133 (test-assert "manifest-add"
 134   (let* ((m0 (manifest '()))
 135          (m1 (manifest-add m0 (list guile-1.8.8)))
 136          (m2 (manifest-add m1 (list guile-2.0.9)))
 137          (m3 (manifest-add m2 (list guile-2.0.9:debug)))
 138          (m4 (manifest-add m3 (list guile-2.0.9:debug))))
 139     (and (match (manifest-entries m1)
 140            ((($ <manifest-entry> "guile" "1.8.8" "out")) #t)
 141            (_ #f))
 142          (match (manifest-entries m2)
 143            ((($ <manifest-entry> "guile" "2.0.9" "out")) #t)
 144            (_ #f))
 145          (equal? m3 m4))))
 146
 147 (test-equal "manifest-add removes duplicates"    ;<https://bugs.gnu.org/30569>
 148   (list guile-2.0.9)
 149   (manifest-entries (manifest-add (manifest '())
 150                                   (list guile-2.0.9 guile-2.0.9))))
 151
 152 (test-assert "manifest-perform-transaction"
 153   (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
 154          (t1 (manifest-transaction
 155               (install (list guile-1.8.8))
 156               (remove (list (manifest-pattern (name "guile")
 157                                               (output "debug"))))))
 158          (t2 (manifest-transaction
 159               (remove (list (manifest-pattern (name "guile")
 160                                               (version "2.0.9")
 161                                               (output #f))))))
 162          (m1 (manifest-perform-transaction m0 t1))
 163          (m2 (manifest-perform-transaction m1 t2))
 164          (m3 (manifest-perform-transaction m0 t2)))
 165     (and (match (manifest-entries m1)
 166            ((($ <manifest-entry> "guile" "1.8.8" "out")) #t)
 167            (_ #f))
 168          (equal? m1 m2)
 169          (null? (manifest-entries m3)))))
 170
 171 (test-assert "manifest-transaction-effects"
 172   (let* ((m0 (manifest (list guile-1.8.8)))
 173          (t  (manifest-transaction
 174               (install (list guile-2.0.9 glibc)))))
 175     (let-values (((remove install upgrade downgrade)
 176                   (manifest-transaction-effects m0 t)))
 177       (and (null? remove) (null? downgrade)
 178            (equal? (list glibc) install)
 179            (equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade)))))
 180
 181 (test-assert "manifest-transaction-effects and downgrades"
 182   (let* ((m0 (manifest (list guile-2.0.9)))
 183          (t  (manifest-transaction (install (list guile-1.8.8)))))
 184     (let-values (((remove install upgrade downgrade)
 185                   (manifest-transaction-effects m0 t)))
 186       (and (null? remove) (null? install) (null? upgrade)
 187            (equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade)))))
 188
 189 (test-assert "manifest-transaction-effects and pseudo-upgrades"
 190   (let* ((m0 (manifest (list guile-2.0.9)))
 191          (t  (manifest-transaction (install (list guile-2.0.9)))))
 192     (let-values (((remove install upgrade downgrade)
 193                   (manifest-transaction-effects m0 t)))
 194       (and (null? remove) (null? install) (null? downgrade)
 195            (equal? (list (cons guile-2.0.9 guile-2.0.9)) upgrade)))))
 196
 197 (test-assert "manifest-transaction-null?"
 198   (manifest-transaction-null? (manifest-transaction)))
 199
 200 (test-assert "manifest-transaction-removal-candidate?"
 201   (let ((m (manifest (list guile-2.0.9)))
 202         (t (manifest-transaction
 203             (remove (list (manifest-pattern (name "guile")))))))
 204     (and (manifest-transaction-removal-candidate? guile-2.0.9 t)
 205          (not (manifest-transaction-removal-candidate? glibc t)))))
 206
 207 (test-assertm "profile-derivation"
 208   (mlet* %store-monad
 209       ((entry ->   (package->manifest-entry %bootstrap-guile))
 210        (guile      (package->derivation %bootstrap-guile))
 211        (drv        (profile-derivation (manifest (list entry))
 212                                        #:hooks '()
 213                                        #:locales? #f))
 214        (profile -> (derivation->output-path drv))
 215        (bindir ->  (string-append profile "/bin"))
 216        (_          (built-derivations (list drv))))
 217     (return (and (file-exists? (string-append bindir "/guile"))
 218                  (string=? (dirname (readlink bindir))
 219                            (derivation->output-path guile))))))
 220
 221 (test-assertm "profile-derivation relative symlinks, one entry"
 222   (mlet* %store-monad
 223       ((entry ->   (package->manifest-entry %bootstrap-guile))
 224        (guile      (package->derivation %bootstrap-guile))
 225        (drv        (profile-derivation (manifest (list entry))
 226                                        #:relative-symlinks? #t
 227                                        #:hooks '()
 228                                        #:locales? #f))
 229        (profile -> (derivation->output-path drv))
 230        (bindir ->  (string-append profile "/bin"))
 231        (_          (built-derivations (list drv))))
 232     (return (and (file-exists? (string-append bindir "/guile"))
 233                  (string=? (readlink bindir)
 234                            (string-append "../"
 235                                           (basename
 236                                            (derivation->output-path guile))
 237                                           "/bin"))))))
 238
 239 (unless (network-reachable?) (test-skip 1))
 240 (test-assertm "profile-derivation relative symlinks, two entries"
 241   (mlet* %store-monad
 242       ((gnu-make-boot0 -> (@@ (gnu packages commencement) gnu-make-boot0))
 243        (manifest -> (packages->manifest
 244                      (list %bootstrap-guile gnu-make-boot0)))
 245        (guile       (package->derivation %bootstrap-guile))
 246        (make        (package->derivation gnu-make-boot0))
 247        (drv         (profile-derivation manifest
 248                                         #:relative-symlinks? #t
 249                                         #:hooks '()
 250                                         #:locales? #f))
 251        (profile ->  (derivation->output-path drv))
 252        (bindir ->   (string-append profile "/bin"))
 253        (_           (built-derivations (list drv))))
 254     (return (and (file-exists? (string-append bindir "/guile"))
 255                  (file-exists? (string-append bindir "/make"))
 256                  (string=? (readlink (string-append bindir "/guile"))
 257                            (string-append "../../"
 258                                           (basename
 259                                            (derivation->output-path guile))
 260                                           "/bin/guile"))
 261                  (string=? (readlink (string-append bindir "/make"))
 262                            (string-append "../../"
 263                                           (basename
 264                                            (derivation->output-path make))
 265                                           "/bin/make"))))))
 266
 267 (test-assertm "profile-derivation, inputs"
 268   (mlet* %store-monad
 269       ((entry ->   (package->manifest-entry packages:glibc "debug"))
 270        (drv        (profile-derivation (manifest (list entry))
 271                                        #:hooks '()
 272                                        #:locales? #f)))
 273     (return (derivation-inputs drv))))
 274
 275 (test-assertm "profile-derivation, cross-compilation"
 276   (mlet* %store-monad
 277       ((manifest -> (packages->manifest (list packages:sed packages:grep)))
 278        (target ->   "arm-linux-gnueabihf")
 279        (grep        (package->cross-derivation packages:grep target))
 280        (sed         (package->cross-derivation packages:sed target))
 281        (locales     (package->derivation packages:glibc-utf8-locales))
 282        (drv         (profile-derivation manifest
 283                                         #:hooks '()
 284                                         #:locales? #t
 285                                         #:target target)))
 286     (define (find-input package)
 287       (let ((name (string-append (package-full-name package "-") ".drv")))
 288         (any (lambda (input)
 289                (let ((input (derivation-input-path input)))
 290                  (and (string-suffix? name input) input)))
 291              (derivation-inputs drv))))
 292
 293     ;; The inputs for grep and sed should be cross-build derivations, but that
 294     ;; for the glibc-utf8-locales should be a native build.
 295     (return (and (string=? (derivation-system drv) (%current-system))
 296                  (string=? (find-input packages:grep)
 297                            (derivation-file-name grep))
 298                  (string=? (find-input packages:sed)
 299                            (derivation-file-name sed))
 300                  (string=? (find-input packages:glibc-utf8-locales)
 301                            (derivation-file-name locales))))))
 302
 303 (test-assert "package->manifest-entry defaults to \"out\""
 304   (let ((outputs (package-outputs packages:glibc)))
 305     (equal? (manifest-entry-output
 306              (package->manifest-entry (package
 307                                         (inherit packages:glibc)
 308                                         (outputs (reverse outputs)))))
 309             (manifest-entry-output
 310              (package->manifest-entry packages:glibc))
 311             "out")))
 312
 313 (test-assertm "profile-manifest, search-paths"
 314   (mlet* %store-monad
 315       ((guile ->   (package
 316                      (inherit %bootstrap-guile)
 317                      (native-search-paths
 318                       (package-native-search-paths packages:guile-2.0))))
 319        (entry ->   (package->manifest-entry guile))
 320        (drv        (profile-derivation (manifest (list entry))
 321                                        #:hooks '()
 322                                        #:locales? #f))
 323        (profile -> (derivation->output-path drv)))
 324     (mbegin %store-monad
 325       (built-derivations (list drv))
 326
 327       ;; Read the manifest back and make sure search paths are preserved.
 328       (let ((manifest (profile-manifest profile)))
 329         (match (manifest-entries manifest)
 330           ((result)
 331            (return (equal? (manifest-entry-search-paths result)
 332                            (manifest-entry-search-paths entry)
 333                            (package-native-search-paths
 334                             packages:guile-2.0)))))))))
 335
 336 (test-assert "package->manifest-entry, search paths"
 337   ;; See <http://bugs.gnu.org/22073>.
 338   (let ((mpl (@ (gnu packages python-xyz) python2-matplotlib)))
 339     (lset= eq?
 340            (package-transitive-native-search-paths mpl)
 341            (manifest-entry-search-paths
 342             (package->manifest-entry mpl)))))
 343
 344 (test-equal "packages->manifest, propagated inputs"
 345   (map (match-lambda
 346          ((label package)
 347           (list (package-name package) (package-version package)
 348                 package)))
 349        (package-propagated-inputs packages:guile-2.2))
 350   (map (lambda (entry)
 351          (list (manifest-entry-name entry)
 352                (manifest-entry-version entry)
 353                (manifest-entry-item entry)))
 354        (manifest-entry-dependencies
 355         (package->manifest-entry packages:guile-2.2))))
 356
 357 (test-assert "manifest-entry-parent"
 358   (let ((entry (package->manifest-entry packages:guile-2.2)))
 359     (match (manifest-entry-dependencies entry)
 360       ((dependencies ..1)
 361        (and (every (lambda (parent)
 362                      (eq? entry (force parent)))
 363                    (map manifest-entry-parent dependencies))
 364             (not (force (manifest-entry-parent entry))))))))
 365
 366 (test-assertm "read-manifest"
 367   (mlet* %store-monad ((manifest -> (packages->manifest
 368                                      (list (package
 369                                              (inherit %bootstrap-guile)
 370                                              (native-search-paths
 371                                               (package-native-search-paths
 372                                                packages:guile-2.0))))))
 373                        (drv (profile-derivation manifest
 374                                                 #:hooks '()
 375                                                 #:locales? #f))
 376                        (out -> (derivation->output-path drv)))
 377     (define (entry->sexp entry)
 378       (list (manifest-entry-name entry)
 379             (manifest-entry-version entry)
 380             (manifest-entry-search-paths entry)
 381             (manifest-entry-dependencies entry)
 382             (force (manifest-entry-parent entry))))
 383
 384     (mbegin %store-monad
 385       (built-derivations (list drv))
 386       (let ((manifest2 (profile-manifest out)))
 387         (return (equal? (map entry->sexp (manifest-entries manifest))
 388                         (map entry->sexp (manifest-entries manifest2))))))))
 389
 390 (test-equal "collision"
 391   '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42"))
 392   (guard (c ((profile-collision-error? c)
 393              (let ((entry1 (profile-collision-error-entry c))
 394                    (entry2 (profile-collision-error-conflict c)))
 395                (list (list (manifest-entry-name entry1)
 396                            (manifest-entry-version entry1))
 397                      (list (manifest-entry-name entry2)
 398                            (manifest-entry-version entry2))))))
 399     (run-with-store %store
 400       (mlet* %store-monad ((p0 -> (package
 401                                     (inherit %bootstrap-guile)
 402                                     (version "42")))
 403                            (p1 -> (dummy-package "p1"
 404                                     (propagated-inputs `(("p0" ,p0)))))
 405                            (manifest -> (packages->manifest
 406                                          (list %bootstrap-guile p1)))
 407                            (drv (profile-derivation manifest
 408                                                     #:hooks '()
 409                                                     #:locales? #f)))
 410         (return #f)))))
 411
 412 (test-equal "collision of propagated inputs"
 413   '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42"))
 414   (guard (c ((profile-collision-error? c)
 415              (let ((entry1 (profile-collision-error-entry c))
 416                    (entry2 (profile-collision-error-conflict c)))
 417                (list (list (manifest-entry-name entry1)
 418                            (manifest-entry-version entry1))
 419                      (list (manifest-entry-name entry2)
 420                            (manifest-entry-version entry2))))))
 421     (run-with-store %store
 422       (mlet* %store-monad ((p0 -> (package
 423                                     (inherit %bootstrap-guile)
 424                                     (version "42")))
 425                            (p1 -> (dummy-package "p1"
 426                                     (propagated-inputs
 427                                      `(("guile" ,%bootstrap-guile)))))
 428                            (p2 -> (dummy-package "p2"
 429                                     (propagated-inputs
 430                                      `(("guile" ,p0)))))
 431                            (manifest -> (packages->manifest (list p1 p2)))
 432                            (drv (profile-derivation manifest
 433                                                     #:hooks '()
 434                                                     #:locales? #f)))
 435         (return #f)))))
 436
 437 (test-assertm "no collision"
 438   ;; Here we have an entry that is "lowered" (its 'item' field is a store file
 439   ;; name) and another entry (its 'item' field is a package) that is
 440   ;; equivalent.
 441   (mlet* %store-monad ((p -> (dummy-package "p"
 442                                (propagated-inputs
 443                                 `(("guile" ,%bootstrap-guile)))))
 444                        (guile    (package->derivation %bootstrap-guile))
 445                        (entry -> (manifest-entry
 446                                    (inherit (package->manifest-entry
 447                                              %bootstrap-guile))
 448                                    (item (derivation->output-path guile))))
 449                        (manifest -> (manifest
 450                                      (list entry
 451                                            (package->manifest-entry p))))
 452                        (drv (profile-derivation manifest)))
 453     (return (->bool drv))))
 454
 455 (test-assertm "etc/profile"
 456   ;; Make sure we get an 'etc/profile' file that at least defines $PATH.
 457   (mlet* %store-monad
 458       ((guile ->   (package
 459                      (inherit %bootstrap-guile)
 460                      (native-search-paths
 461                       (package-native-search-paths packages:guile-2.0))))
 462        (entry ->   (package->manifest-entry guile))
 463        (drv        (profile-derivation (manifest (list entry))
 464                                        #:hooks '()
 465                                        #:locales? #f))
 466        (profile -> (derivation->output-path drv)))
 467     (mbegin %store-monad
 468       (built-derivations (list drv))
 469       (let* ((pipe (open-input-pipe
 470                     (string-append "unset GUIX_PROFILE; "
 471                                    ;; 'source' is a Bashism; use '.' (dot).
 472                                    ". " profile "/etc/profile; "
 473                                    ;; Don't try to parse set(1) output because
 474                                    ;; it differs among shells; just use echo.
 475                                    "echo $PATH")))
 476              (path (get-string-all pipe)))
 477         (return
 478          (and (zero? (close-pipe pipe))
 479               (string-contains path (string-append profile "/bin"))))))))
 480
 481 (test-assertm "etc/profile when etc/ already exists"
 482   ;; Here 'union-build' makes the profile's etc/ a symlink to the package's
 483   ;; etc/ directory, which makes it read-only.  Make sure the profile build
 484   ;; handles that.
 485   (mlet* %store-monad
 486       ((thing ->   (dummy-package "dummy"
 487                      (build-system trivial-build-system)
 488                      (arguments
 489                       `(#:guile ,%bootstrap-guile
 490                         #:builder
 491                         (let ((out (assoc-ref %outputs "out")))
 492                           (mkdir out)
 493                           (mkdir (string-append out "/etc"))
 494                           (call-with-output-file (string-append out "/etc/foo")
 495                             (lambda (port)
 496                               (display "foo!" port)))
 497                           #t)))))
 498        (entry ->   (package->manifest-entry thing))
 499        (drv        (profile-derivation (manifest (list entry))
 500                                        #:hooks '()
 501                                        #:locales? #f))
 502        (profile -> (derivation->output-path drv)))
 503     (mbegin %store-monad
 504       (built-derivations (list drv))
 505       (return (and (file-exists? (string-append profile "/etc/profile"))
 506                    (string=? (call-with-input-file
 507                                  (string-append profile "/etc/foo")
 508                                get-string-all)
 509                              "foo!"))))))
 510
 511 (test-assertm "etc/profile when etc/ is a symlink"
 512   ;; When etc/ is a symlink, the unsymlink code in 0.8.2 would fail
 513   ;; gracelessly because 'scandir' would return #f.
 514   (mlet* %store-monad
 515       ((thing ->   (dummy-package "dummy"
 516                      (build-system trivial-build-system)
 517                      (arguments
 518                       `(#:guile ,%bootstrap-guile
 519                         #:builder
 520                         (let ((out (assoc-ref %outputs "out")))
 521                           (mkdir out)
 522                           (mkdir (string-append out "/foo"))
 523                           (symlink "foo" (string-append out "/etc"))
 524                           (call-with-output-file (string-append out "/etc/bar")
 525                             (lambda (port)
 526                               (display "foo!" port)))
 527                           #t)))))
 528        (entry ->   (package->manifest-entry thing))
 529        (drv        (profile-derivation (manifest (list entry))
 530                                        #:hooks '()
 531                                        #:locales? #f))
 532        (profile -> (derivation->output-path drv)))
 533     (mbegin %store-monad
 534       (built-derivations (list drv))
 535       (return (and (file-exists? (string-append profile "/etc/profile"))
 536                    (string=? (call-with-input-file
 537                                  (string-append profile "/etc/bar")
 538                                get-string-all)
 539                              "foo!"))))))
 540
 541 (test-assertm "profile-derivation when etc/ is a relative symlink"
 542   ;; See <https://bugs.gnu.org/32686>.
 543   (mlet* %store-monad
 544       ((etc        (gexp->derivation
 545                     "etc"
 546                     #~(begin
 547                         (mkdir #$output)
 548                         (call-with-output-file (string-append #$output "/foo")
 549                           (lambda (port)
 550                             (display "Heya!" port))))))
 551        (thing ->   (dummy-package "dummy"
 552                      (build-system trivial-build-system)
 553                      (inputs
 554                       `(("etc" ,etc)))
 555                      (arguments
 556                       `(#:guile ,%bootstrap-guile
 557                         #:builder
 558                         (let ((out (assoc-ref %outputs "out"))
 559                               (etc (assoc-ref %build-inputs "etc")))
 560                           (mkdir out)
 561                           (symlink etc (string-append out "/etc"))
 562                           #t)))))
 563        (entry ->   (package->manifest-entry thing))
 564        (drv        (profile-derivation (manifest (list entry))
 565                                        #:relative-symlinks? #t
 566                                        #:hooks '()
 567                                        #:locales? #f))
 568        (profile -> (derivation->output-path drv)))
 569     (mbegin %store-monad
 570       (built-derivations (list drv))
 571       (return (string=? (call-with-input-file
 572                             (string-append profile "/etc/foo")
 573                           get-string-all)
 574                         "Heya!")))))
 575
 576 (test-equalm "union vs. dangling symlink"        ;<https://bugs.gnu.org/26949>
 577   "does-not-exist"
 578   (mlet* %store-monad
 579       ((thing1 ->  (dummy-package "dummy"
 580                      (build-system trivial-build-system)
 581                      (arguments
 582                       `(#:guile ,%bootstrap-guile
 583                         #:builder
 584                         (let ((out (assoc-ref %outputs "out")))
 585                           (mkdir out)
 586                           (symlink "does-not-exist"
 587                                    (string-append out "/dangling"))
 588                           #t)))))
 589        (thing2 ->  (package (inherit thing1) (name "dummy2")))
 590        (drv        (profile-derivation (packages->manifest
 591                                         (list thing1 thing2))
 592                                        #:hooks '()
 593                                        #:locales? #f))
 594        (profile -> (derivation->output-path drv)))
 595     (mbegin %store-monad
 596       (built-derivations (list drv))
 597       (return (readlink (readlink (string-append profile "/dangling")))))))
 598
 599 (test-equalm "profile in profile"
 600   '("foo" "0")
 601
 602   ;; Make sure we can build a profile that has another profile has one of its
 603   ;; entries.  The new profile's /manifest and /etc/profile must override the
 604   ;; other's.
 605   (mlet* %store-monad
 606       ((prof0 (profile-derivation
 607                (manifest
 608                 (list (package->manifest-entry %bootstrap-guile)))
 609                #:hooks '()
 610                #:locales? #f))
 611        (prof1 (profile-derivation
 612                (manifest (list (manifest-entry
 613                                  (name "foo")
 614                                  (version "0")
 615                                  (item prof0))))
 616                #:hooks '()
 617                #:locales? #f)))
 618     (mbegin %store-monad
 619       (built-derivations (list prof1))
 620       (let ((out (derivation->output-path prof1)))
 621         (return (and (file-exists?
 622                       (string-append out "/bin/guile"))
 623                      (let ((manifest (profile-manifest out)))
 624                        (match (manifest-entries manifest)
 625                          ((entry)
 626                           (list (manifest-entry-name entry)
 627                                 (manifest-entry-version entry)))))))))))
 628
 629 (test-end "profiles")
 630
 631 ;;; Local Variables:
 632 ;;; eval: (put 'dummy-package 'scheme-indent-function 1)
 633 ;;; End: