diff options
author | Marius Bakke <mbakke@fastmail.com> | 2018-06-11 23:52:15 +0200 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2018-06-11 23:52:15 +0200 |
commit | a032b4454b3fc67e11e9fc2d8c2345288065fa29 (patch) | |
tree | c208124b79dbd2224b68c52106aa72ff2ebfa7ab /tests/profiles.scm | |
parent | b5724230fed2d043206df20d12a45bb962b7ee77 (diff) | |
parent | 6321ce42ab4d9ab788d858cb19bde4aa7a0e3ecc (diff) | |
download | guix-a032b4454b3fc67e11e9fc2d8c2345288065fa29.tar guix-a032b4454b3fc67e11e9fc2d8c2345288065fa29.tar.gz |
Merge branch 'master' into staging
Diffstat (limited to 'tests/profiles.scm')
-rw-r--r-- | tests/profiles.scm | 63 |
1 files changed, 55 insertions, 8 deletions
diff --git a/tests/profiles.scm b/tests/profiles.scm index 92eb08cb9e..3a59a0cc4f 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -223,6 +223,52 @@ (string=? (dirname (readlink bindir)) (derivation->output-path guile)))))) +(test-assertm "profile-derivation relative symlinks, one entry" + (mlet* %store-monad + ((entry -> (package->manifest-entry %bootstrap-guile)) + (guile (package->derivation %bootstrap-guile)) + (drv (profile-derivation (manifest (list entry)) + #:relative-symlinks? #t + #:hooks '() + #:locales? #f)) + (profile -> (derivation->output-path drv)) + (bindir -> (string-append profile "/bin")) + (_ (built-derivations (list drv)))) + (return (and (file-exists? (string-append bindir "/guile")) + (string=? (readlink bindir) + (string-append "../" + (basename + (derivation->output-path guile)) + "/bin")))))) + +(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))) + (guile (package->derivation %bootstrap-guile)) + (make (package->derivation gnu-make-boot0)) + (drv (profile-derivation manifest + #:relative-symlinks? #t + #:hooks '() + #:locales? #f)) + (profile -> (derivation->output-path drv)) + (bindir -> (string-append profile "/bin")) + (_ (built-derivations (list drv)))) + (return (and (file-exists? (string-append bindir "/guile")) + (file-exists? (string-append bindir "/make")) + (string=? (readlink (string-append bindir "/guile")) + (string-append "../../" + (basename + (derivation->output-path guile)) + "/bin/guile")) + (string=? (readlink (string-append bindir "/make")) + (string-append "../../" + (basename + (derivation->output-path make)) + "/bin/make")))))) + (test-assertm "profile-derivation, inputs" (mlet* %store-monad ((entry -> (package->manifest-entry packages:glibc "debug")) @@ -242,8 +288,8 @@ #:hooks '() #:locales? #t #:target target))) - (define (find-input name) - (let ((name (string-append name ".drv"))) + (define (find-input package) + (let ((name (string-append (package-full-name package "-") ".drv"))) (any (lambda (input) (let ((input (derivation-input-path input))) (and (string-suffix? name input) input))) @@ -252,12 +298,11 @@ ;; The inputs for grep and sed should be cross-build derivations, but that ;; for the glibc-utf8-locales should be a native build. (return (and (string=? (derivation-system drv) (%current-system)) - (string=? (find-input (package-full-name packages:grep)) + (string=? (find-input packages:grep) (derivation-file-name grep)) - (string=? (find-input (package-full-name packages:sed)) + (string=? (find-input packages:sed) (derivation-file-name sed)) - (string=? (find-input - (package-full-name packages:glibc-utf8-locales)) + (string=? (find-input packages:glibc-utf8-locales) (derivation-file-name locales)))))) (test-assert "package->manifest-entry defaults to \"out\"" @@ -453,7 +498,8 @@ (mkdir (string-append out "/etc")) (call-with-output-file (string-append out "/etc/foo") (lambda (port) - (display "foo!" port)))))))) + (display "foo!" port))) + #t))))) (entry -> (package->manifest-entry thing)) (drv (profile-derivation (manifest (list entry)) #:hooks '() @@ -482,7 +528,8 @@ (symlink "foo" (string-append out "/etc")) (call-with-output-file (string-append out "/etc/bar") (lambda (port) - (display "foo!" port)))))))) + (display "foo!" port))) + #t))))) (entry -> (package->manifest-entry thing)) (drv (profile-derivation (manifest (list entry)) #:hooks '() |