tests/profiles.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 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 (null? (manifest-matching-entries m
  97                                            (list (manifest-pattern
  98                                                    (name "python")))))
  99          (equal? e
 100                  (manifest-matching-entries m
 101                                             (list (manifest-pattern
 102                                                     (name "guile")
 103                                                     (output #f)))))
 104          (equal? (list guile-2.0.9)
 105                  (manifest-matching-entries m
 106                                             (list (manifest-pattern
 107                                                     (name "guile")
 108                                                     (version "2.0.9"))))))))
 109
 110 (test-assert "manifest-remove"
 111   (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
 112          (m1 (manifest-remove m0
 113                               (list (manifest-pattern (name "guile")))))
 114          (m2 (manifest-remove m1
 115                               (list (manifest-pattern (name "guile"))))) ; same
 116          (m3 (manifest-remove m2
 117                               (list (manifest-pattern
 118                                       (name "guile") (output "debug")))))
 119          (m4 (manifest-remove m3
 120                               (list (manifest-pattern (name "guile"))))))
 121     (match (manifest-entries m2)
 122       ((($ <manifest-entry> "guile" "2.0.9" "debug"))
 123        (and (equal? m1 m2)
 124             (null? (manifest-entries m3))
 125             (null? (manifest-entries m4)))))))
 126
 127 (test-assert "manifest-add"
 128   (let* ((m0 (manifest '()))
 129          (m1 (manifest-add m0 (list guile-1.8.8)))
 130          (m2 (manifest-add m1 (list guile-2.0.9)))
 131          (m3 (manifest-add m2 (list guile-2.0.9:debug)))
 132          (m4 (manifest-add m3 (list guile-2.0.9:debug))))
 133     (and (match (manifest-entries m1)
 134            ((($ <manifest-entry> "guile" "1.8.8" "out")) #t)
 135            (_ #f))
 136          (match (manifest-entries m2)
 137            ((($ <manifest-entry> "guile" "2.0.9" "out")) #t)
 138            (_ #f))
 139          (equal? m3 m4))))
 140
 141 (test-equal "manifest-add removes duplicates"    ;<https://bugs.gnu.org/30569>
 142   (list guile-2.0.9)
 143   (manifest-entries (manifest-add (manifest '())
 144                                   (list guile-2.0.9 guile-2.0.9))))
 145
 146 (test-assert "manifest-perform-transaction"
 147   (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
 148          (t1 (manifest-transaction
 149               (install (list guile-1.8.8))
 150               (remove (list (manifest-pattern (name "guile")
 151                                               (output "debug"))))))
 152          (t2 (manifest-transaction
 153               (remove (list (manifest-pattern (name "guile")
 154                                               (version "2.0.9")
 155                                               (output #f))))))
 156          (m1 (manifest-perform-transaction m0 t1))
 157          (m2 (manifest-perform-transaction m1 t2))
 158          (m3 (manifest-perform-transaction m0 t2)))
 159     (and (match (manifest-entries m1)
 160            ((($ <manifest-entry> "guile" "1.8.8" "out")) #t)
 161            (_ #f))
 162          (equal? m1 m2)
 163          (null? (manifest-entries m3)))))
 164
 165 (test-assert "manifest-transaction-effects"
 166   (let* ((m0 (manifest (list guile-1.8.8)))
 167          (t  (manifest-transaction
 168               (install (list guile-2.0.9 glibc))
 169               (remove (list (manifest-pattern (name "coreutils")))))))
 170     (let-values (((remove install upgrade downgrade)
 171                   (manifest-transaction-effects m0 t)))
 172       (and (null? remove) (null? downgrade)
 173            (equal? (list glibc) install)
 174            (equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade)))))
 175
 176 (test-assert "manifest-transaction-effects and downgrades"
 177   (let* ((m0 (manifest (list guile-2.0.9)))
 178          (t  (manifest-transaction (install (list guile-1.8.8)))))
 179     (let-values (((remove install upgrade downgrade)
 180                   (manifest-transaction-effects m0 t)))
 181       (and (null? remove) (null? install) (null? upgrade)
 182            (equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade)))))
 183
 184 (test-assert "manifest-transaction-effects and pseudo-upgrades"
 185   (let* ((m0 (manifest (list guile-2.0.9)))
 186          (t  (manifest-transaction (install (list guile-2.0.9)))))
 187     (let-values (((remove install upgrade downgrade)
 188                   (manifest-transaction-effects m0 t)))
 189       (and (null? remove) (null? install) (null? downgrade)
 190            (equal? (list (cons guile-2.0.9 guile-2.0.9)) upgrade)))))
 191
 192 (test-assert "manifest-transaction-null?"
 193   (manifest-transaction-null? (manifest-transaction)))
 194
 195 (test-assert "manifest-transaction-removal-candidate?"
 196   (let ((m (manifest (list guile-2.0.9)))
 197         (t (manifest-transaction
 198             (remove (list (manifest-pattern (name "guile")))))))
 199     (and (manifest-transaction-removal-candidate? guile-2.0.9 t)
 200          (not (manifest-transaction-removal-candidate? glibc t)))))
 201
 202 (test-assertm "profile-derivation"
 203   (mlet* %store-monad
 204       ((entry ->   (package->manifest-entry %bootstrap-guile))
 205        (guile      (package->derivation %bootstrap-guile))
 206        (drv        (profile-derivation (manifest (list entry))
 207                                        #:hooks '()
 208                                        #:locales? #f))
 209        (profile -> (derivation->output-path drv))
 210        (bindir ->  (string-append profile "/bin"))
 211        (_          (built-derivations (list drv))))
 212     (return (and (file-exists? (string-append bindir "/guile"))
 213                  (string=? (dirname (readlink bindir))
 214                            (derivation->output-path guile))))))
 215
 216 (test-assertm "profile-derivation relative symlinks, one entry"
 217   (mlet* %store-monad
 218       ((entry ->   (package->manifest-entry %bootstrap-guile))
 219        (guile      (package->derivation %bootstrap-guile))
 220        (drv        (profile-derivation (manifest (list entry))
 221                                        #:relative-symlinks? #t
 222                                        #:hooks '()
 223                                        #:locales? #f))
 224        (profile -> (derivation->output-path drv))
 225        (bindir ->  (string-append profile "/bin"))
 226        (_          (built-derivations (list drv))))
 227     (return (and (file-exists? (string-append bindir "/guile"))
 228                  (string=? (readlink bindir)
 229                            (string-append "../"
 230                                           (basename
 231                                            (derivation->output-path guile))
 232                                           "/bin"))))))
 233
 234 (unless (network-reachable?) (test-skip 1))
 235 (test-assertm "profile-derivation relative symlinks, two entries"
 236   (mlet* %store-monad
 237       ((gnu-make-boot0 -> (@@ (gnu packages commencement) gnu-make-boot0))
 238        (manifest -> (packages->manifest
 239                      (list %bootstrap-guile gnu-make-boot0)))
 240        (guile       (package->derivation %bootstrap-guile))
 241        (make        (package->derivation gnu-make-boot0))
 242        (drv         (profile-derivation manifest
 243                                         #:relative-symlinks? #t
 244                                         #:hooks '()
 245                                         #:locales? #f))
 246        (profile ->  (derivation->output-path drv))
 247        (bindir ->   (string-append profile "/bin"))
 248        (_           (built-derivations (list drv))))
 249     (return (and (file-exists? (string-append bindir "/guile"))
 250                  (file-exists? (string-append bindir "/make"))
 251                  (string=? (readlink (string-append bindir "/guile"))
 252                            (string-append "../../"
 253                                           (basename
 254                                            (derivation->output-path guile))
 255                                           "/bin/guile"))
 256                  (string=? (readlink (string-append bindir "/make"))
 257                            (string-append "../../"
 258                                           (basename
 259                                            (derivation->output-path make))
 260                                           "/bin/make"))))))
 261
 262 (test-assertm "profile-derivation, inputs"
 263   (mlet* %store-monad
 264       ((entry ->   (package->manifest-entry packages:glibc "debug"))
 265        (drv        (profile-derivation (manifest (list entry))
 266                                        #:hooks '()
 267                                        #:locales? #f)))
 268     (return (derivation-inputs drv))))
 269
 270 (test-assertm "profile-derivation, cross-compilation"
 271   (mlet* %store-monad
 272       ((manifest -> (packages->manifest (list packages:sed packages:grep)))
 273        (target ->   "arm-linux-gnueabihf")
 274        (grep        (package->cross-derivation packages:grep target))
 275        (sed         (package->cross-derivation packages:sed target))
 276        (locales     (package->derivation packages:glibc-utf8-locales))
 277        (drv         (profile-derivation manifest
 278                                         #:hooks '()
 279                                         #:locales? #t
 280                                         #:target target)))
 281     (define (find-input package)
 282       (let ((name (string-append (package-full-name package "-") ".drv")))
 283         (any (lambda (input)
 284                (let ((input (derivation-input-path input)))
 285                  (and (string-suffix? name input) input)))
 286              (derivation-inputs drv))))
 287
 288     ;; The inputs for grep and sed should be cross-build derivations, but that
 289     ;; for the glibc-utf8-locales should be a native build.
 290     (return (and (string=? (derivation-system drv) (%current-system))
 291                  (string=? (find-input packages:grep)
 292                            (derivation-file-name grep))
 293                  (string=? (find-input packages:sed)
 294                            (derivation-file-name sed))
 295                  (string=? (find-input packages:glibc-utf8-locales)
 296                            (derivation-file-name locales))))))
 297
 298 (test-assert "package->manifest-entry defaults to \"out\""
 299   (let ((outputs (package-outputs packages:glibc)))
 300     (equal? (manifest-entry-output
 301              (package->manifest-entry (package
 302                                         (inherit packages:glibc)
 303                                         (outputs (reverse outputs)))))
 304             (manifest-entry-output
 305              (package->manifest-entry packages:glibc))
 306             "out")))
 307
 308 (test-assertm "profile-manifest, search-paths"
 309   (mlet* %store-monad
 310       ((guile ->   (package
 311                      (inherit %bootstrap-guile)
 312                      (native-search-paths
 313                       (package-native-search-paths packages:guile-2.0))))
 314        (entry ->   (package->manifest-entry guile))
 315        (drv        (profile-derivation (manifest (list entry))
 316                                        #:hooks '()
 317                                        #:locales? #f))
 318        (profile -> (derivation->output-path drv)))
 319     (mbegin %store-monad
 320       (built-derivations (list drv))
 321
 322       ;; Read the manifest back and make sure search paths are preserved.
 323       (let ((manifest (profile-manifest profile)))
 324         (match (manifest-entries manifest)
 325           ((result)
 326            (return (equal? (manifest-entry-search-paths result)
 327                            (manifest-entry-search-paths entry)
 328                            (package-native-search-paths
 329                             packages:guile-2.0)))))))))
 330
 331 (test-assert "package->manifest-entry, search paths"
 332   ;; See <http://bugs.gnu.org/22073>.
 333   (let ((mpl (@ (gnu packages python) python2-matplotlib)))
 334     (lset= eq?
 335            (package-transitive-native-search-paths mpl)
 336            (manifest-entry-search-paths
 337             (package->manifest-entry mpl)))))
 338
 339 (test-equal "packages->manifest, propagated inputs"
 340   (map (match-lambda
 341          ((label package)
 342           (list (package-name package) (package-version package)
 343                 package)))
 344        (package-propagated-inputs packages:guile-2.2))
 345   (map (lambda (entry)
 346          (list (manifest-entry-name entry)
 347                (manifest-entry-version entry)
 348                (manifest-entry-item entry)))
 349        (manifest-entry-dependencies
 350         (package->manifest-entry packages:guile-2.2))))
 351
 352 (test-assert "manifest-entry-parent"
 353   (let ((entry (package->manifest-entry packages:guile-2.2)))
 354     (match (manifest-entry-dependencies entry)
 355       ((dependencies ..1)
 356        (and (every (lambda (parent)
 357                      (eq? entry (force parent)))
 358                    (map manifest-entry-parent dependencies))
 359             (not (force (manifest-entry-parent entry))))))))
 360
 361 (test-assertm "read-manifest"
 362   (mlet* %store-monad ((manifest -> (packages->manifest
 363                                      (list (package
 364                                              (inherit %bootstrap-guile)
 365                                              (native-search-paths
 366                                               (package-native-search-paths
 367                                                packages:guile-2.0))))))
 368                        (drv (profile-derivation manifest
 369                                                 #:hooks '()
 370                                                 #:locales? #f))
 371                        (out -> (derivation->output-path drv)))
 372     (define (entry->sexp entry)
 373       (list (manifest-entry-name entry)
 374             (manifest-entry-version entry)
 375             (manifest-entry-search-paths entry)
 376             (manifest-entry-dependencies entry)
 377             (force (manifest-entry-parent entry))))
 378
 379     (mbegin %store-monad
 380       (built-derivations (list drv))
 381       (let ((manifest2 (profile-manifest out)))
 382         (return (equal? (map entry->sexp (manifest-entries manifest))
 383                         (map entry->sexp (manifest-entries manifest2))))))))
 384
 385 (test-equal "collision"
 386   '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42"))
 387   (guard (c ((profile-collision-error? c)
 388              (let ((entry1 (profile-collision-error-entry c))
 389                    (entry2 (profile-collision-error-conflict c)))
 390                (list (list (manifest-entry-name entry1)
 391                            (manifest-entry-version entry1))
 392                      (list (manifest-entry-name entry2)
 393                            (manifest-entry-version entry2))))))
 394     (run-with-store %store
 395       (mlet* %store-monad ((p0 -> (package
 396                                     (inherit %bootstrap-guile)
 397                                     (version "42")))
 398                            (p1 -> (dummy-package "p1"
 399                                     (propagated-inputs `(("p0" ,p0)))))
 400                            (manifest -> (packages->manifest
 401                                          (list %bootstrap-guile p1)))
 402                            (drv (profile-derivation manifest
 403                                                     #:hooks '()
 404                                                     #:locales? #f)))
 405         (return #f)))))
 406
 407 (test-equal "collision of propagated inputs"
 408   '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42"))
 409   (guard (c ((profile-collision-error? c)
 410              (let ((entry1 (profile-collision-error-entry c))
 411                    (entry2 (profile-collision-error-conflict c)))
 412                (list (list (manifest-entry-name entry1)
 413                            (manifest-entry-version entry1))
 414                      (list (manifest-entry-name entry2)
 415                            (manifest-entry-version entry2))))))
 416     (run-with-store %store
 417       (mlet* %store-monad ((p0 -> (package
 418                                     (inherit %bootstrap-guile)
 419                                     (version "42")))
 420                            (p1 -> (dummy-package "p1"
 421                                     (propagated-inputs
 422                                      `(("guile" ,%bootstrap-guile)))))
 423                            (p2 -> (dummy-package "p2"
 424                                     (propagated-inputs
 425                                      `(("guile" ,p0)))))
 426                            (manifest -> (packages->manifest (list p1 p2)))
 427                            (drv (profile-derivation manifest
 428                                                     #:hooks '()
 429                                                     #:locales? #f)))
 430         (return #f)))))
 431
 432 (test-assertm "no collision"
 433   ;; Here we have an entry that is "lowered" (its 'item' field is a store file
 434   ;; name) and another entry (its 'item' field is a package) that is
 435   ;; equivalent.
 436   (mlet* %store-monad ((p -> (dummy-package "p"
 437                                (propagated-inputs
 438                                 `(("guile" ,%bootstrap-guile)))))
 439                        (guile    (package->derivation %bootstrap-guile))
 440                        (entry -> (manifest-entry
 441                                    (inherit (package->manifest-entry
 442                                              %bootstrap-guile))
 443                                    (item (derivation->output-path guile))))
 444                        (manifest -> (manifest
 445                                      (list entry
 446                                            (package->manifest-entry p))))
 447                        (drv (profile-derivation manifest)))
 448     (return (->bool drv))))
 449
 450 (test-assertm "etc/profile"
 451   ;; Make sure we get an 'etc/profile' file that at least defines $PATH.
 452   (mlet* %store-monad
 453       ((guile ->   (package
 454                      (inherit %bootstrap-guile)
 455                      (native-search-paths
 456                       (package-native-search-paths packages:guile-2.0))))
 457        (entry ->   (package->manifest-entry guile))
 458        (drv        (profile-derivation (manifest (list entry))
 459                                        #:hooks '()
 460                                        #:locales? #f))
 461        (profile -> (derivation->output-path drv)))
 462     (mbegin %store-monad
 463       (built-derivations (list drv))
 464       (let* ((pipe (open-input-pipe
 465                     (string-append "unset GUIX_PROFILE; "
 466                                    ;; 'source' is a Bashism; use '.' (dot).
 467                                    ". " profile "/etc/profile; "
 468                                    ;; Don't try to parse set(1) output because
 469                                    ;; it differs among shells; just use echo.
 470                                    "echo $PATH")))
 471              (path (get-string-all pipe)))
 472         (return
 473          (and (zero? (close-pipe pipe))
 474               (string-contains path (string-append profile "/bin"))))))))
 475
 476 (test-assertm "etc/profile when etc/ already exists"
 477   ;; Here 'union-build' makes the profile's etc/ a symlink to the package's
 478   ;; etc/ directory, which makes it read-only.  Make sure the profile build
 479   ;; handles that.
 480   (mlet* %store-monad
 481       ((thing ->   (dummy-package "dummy"
 482                      (build-system trivial-build-system)
 483                      (arguments
 484                       `(#:guile ,%bootstrap-guile
 485                         #:builder
 486                         (let ((out (assoc-ref %outputs "out")))
 487                           (mkdir out)
 488                           (mkdir (string-append out "/etc"))
 489                           (call-with-output-file (string-append out "/etc/foo")
 490                             (lambda (port)
 491                               (display "foo!" port)))
 492                           #t)))))
 493        (entry ->   (package->manifest-entry thing))
 494        (drv        (profile-derivation (manifest (list entry))
 495                                        #:hooks '()
 496                                        #:locales? #f))
 497        (profile -> (derivation->output-path drv)))
 498     (mbegin %store-monad
 499       (built-derivations (list drv))
 500       (return (and (file-exists? (string-append profile "/etc/profile"))
 501                    (string=? (call-with-input-file
 502                                  (string-append profile "/etc/foo")
 503                                get-string-all)
 504                              "foo!"))))))
 505
 506 (test-assertm "etc/profile when etc/ is a symlink"
 507   ;; When etc/ is a symlink, the unsymlink code in 0.8.2 would fail
 508   ;; gracelessly because 'scandir' would return #f.
 509   (mlet* %store-monad
 510       ((thing ->   (dummy-package "dummy"
 511                      (build-system trivial-build-system)
 512                      (arguments
 513                       `(#:guile ,%bootstrap-guile
 514                         #:builder
 515                         (let ((out (assoc-ref %outputs "out")))
 516                           (mkdir out)
 517                           (mkdir (string-append out "/foo"))
 518                           (symlink "foo" (string-append out "/etc"))
 519                           (call-with-output-file (string-append out "/etc/bar")
 520                             (lambda (port)
 521                               (display "foo!" port)))
 522                           #t)))))
 523        (entry ->   (package->manifest-entry thing))
 524        (drv        (profile-derivation (manifest (list entry))
 525                                        #:hooks '()
 526                                        #:locales? #f))
 527        (profile -> (derivation->output-path drv)))
 528     (mbegin %store-monad
 529       (built-derivations (list drv))
 530       (return (and (file-exists? (string-append profile "/etc/profile"))
 531                    (string=? (call-with-input-file
 532                                  (string-append profile "/etc/bar")
 533                                get-string-all)
 534                              "foo!"))))))
 535
 536 (test-assertm "profile-derivation when etc/ is a relative symlink"
 537   ;; See <https://bugs.gnu.org/32686>.
 538   (mlet* %store-monad
 539       ((etc        (gexp->derivation
 540                     "etc"
 541                     #~(begin
 542                         (mkdir #$output)
 543                         (call-with-output-file (string-append #$output "/foo")
 544                           (lambda (port)
 545                             (display "Heya!" port))))))
 546        (thing ->   (dummy-package "dummy"
 547                      (build-system trivial-build-system)
 548                      (inputs
 549                       `(("etc" ,etc)))
 550                      (arguments
 551                       `(#:guile ,%bootstrap-guile
 552                         #:builder
 553                         (let ((out (assoc-ref %outputs "out"))
 554                               (etc (assoc-ref %build-inputs "etc")))
 555                           (mkdir out)
 556                           (symlink etc (string-append out "/etc"))
 557                           #t)))))
 558        (entry ->   (package->manifest-entry thing))
 559        (drv        (profile-derivation (manifest (list entry))
 560                                        #:relative-symlinks? #t
 561                                        #:hooks '()
 562                                        #:locales? #f))
 563        (profile -> (derivation->output-path drv)))
 564     (mbegin %store-monad
 565       (built-derivations (list drv))
 566       (return (string=? (call-with-input-file
 567                             (string-append profile "/etc/foo")
 568                           get-string-all)
 569                         "Heya!")))))
 570
 571 (test-equalm "union vs. dangling symlink"        ;<https://bugs.gnu.org/26949>
 572   "does-not-exist"
 573   (mlet* %store-monad
 574       ((thing1 ->  (dummy-package "dummy"
 575                      (build-system trivial-build-system)
 576                      (arguments
 577                       `(#:guile ,%bootstrap-guile
 578                         #:builder
 579                         (let ((out (assoc-ref %outputs "out")))
 580                           (mkdir out)
 581                           (symlink "does-not-exist"
 582                                    (string-append out "/dangling"))
 583                           #t)))))
 584        (thing2 ->  (package (inherit thing1) (name "dummy2")))
 585        (drv        (profile-derivation (packages->manifest
 586                                         (list thing1 thing2))
 587                                        #:hooks '()
 588                                        #:locales? #f))
 589        (profile -> (derivation->output-path drv)))
 590     (mbegin %store-monad
 591       (built-derivations (list drv))
 592       (return (readlink (readlink (string-append profile "/dangling")))))))
 593
 594 (test-end "profiles")
 595
 596 ;;; Local Variables:
 597 ;;; eval: (put 'dummy-package 'scheme-indent-function 1)
 598 ;;; End: