diff options
| author | Leo Famulari <leo@famulari.name> | 2018-09-13 13:32:39 -0400 |
|---|---|---|
| committer | Leo Famulari <leo@famulari.name> | 2018-09-13 13:32:39 -0400 |
| commit | d7639407110a584c18bb362c942eeb0933188c66 (patch) | |
| tree | 8068d0737e2a65f8f9f7080b7f9fb36a74e58e2c /tests | |
| parent | 36e8185667c41740786d9b2eb3672a0f8b902ed8 (diff) | |
| parent | 7d1cc612938565d935c53bd7a429f41d1f048dae (diff) | |
| download | patches-d7639407110a584c18bb362c942eeb0933188c66.tar patches-d7639407110a584c18bb362c942eeb0933188c66.tar.gz | |
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/profiles.scm | 36 |
1 files changed, 36 insertions, 0 deletions
diff --git a/tests/profiles.scm b/tests/profiles.scm index 3a59a0cc4f..9f366a04ef 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -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) @@ -543,6 +544,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 |