;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;;
;;; This file is part of GNU Guix.
(run-with-store %store exp
#:guile-for-build (%guile-for-build))))
+(define-syntax-rule (test-equalm name value exp)
+ (test-equal name
+ value
+ (run-with-store %store exp
+ #:guile-for-build (%guile-for-build))))
+
;; Example manifest entries.
(define guile-1.8.8
(and (null? remove) (null? install) (null? downgrade)
(equal? (list (cons guile-2.0.9 guile-2.0.9)) upgrade)))))
+(test-assert "manifest-transaction-null?"
+ (manifest-transaction-null? (manifest-transaction)))
+
(test-assertm "profile-derivation"
(mlet* %store-monad
((entry -> (package->manifest-entry %bootstrap-guile))
(guile (package->derivation %bootstrap-guile))
(drv (profile-derivation (manifest (list entry))
- #:hooks '()))
+ #:hooks '()
+ #:locales? #f))
(profile -> (derivation->output-path drv))
(bindir -> (string-append profile "/bin"))
(_ (built-derivations (list drv))))
(mlet* %store-monad
((entry -> (package->manifest-entry packages:glibc "debug"))
(drv (profile-derivation (manifest (list entry))
- #:hooks '())))
+ #:hooks '()
+ #:locales? #f)))
(return (derivation-inputs drv))))
+(test-assertm "profile-derivation, cross-compilation"
+ (mlet* %store-monad
+ ((manifest -> (packages->manifest (list packages:sed packages:grep)))
+ (target -> "arm-linux-gnueabihf")
+ (grep (package->cross-derivation packages:grep target))
+ (sed (package->cross-derivation packages:sed target))
+ (locales (package->derivation packages:glibc-utf8-locales))
+ (drv (profile-derivation manifest
+ #:hooks '()
+ #:locales? #t
+ #:target target)))
+ (define (find-input name)
+ (let ((name (string-append name ".drv")))
+ (any (lambda (input)
+ (let ((input (derivation-input-path input)))
+ (and (string-suffix? name input) input)))
+ (derivation-inputs drv))))
+
+ ;; 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))
+ (derivation-file-name grep))
+ (string=? (find-input (package-full-name packages:sed))
+ (derivation-file-name sed))
+ (string=? (find-input
+ (package-full-name packages:glibc-utf8-locales))
+ (derivation-file-name locales))))))
+
+(test-assert "package->manifest-entry defaults to \"out\""
+ (let ((outputs (package-outputs packages:glibc)))
+ (equal? (manifest-entry-output
+ (package->manifest-entry (package
+ (inherit packages:glibc)
+ (outputs (reverse outputs)))))
+ (manifest-entry-output
+ (package->manifest-entry packages:glibc))
+ "out")))
+
(test-assertm "profile-manifest, search-paths"
(mlet* %store-monad
((guile -> (package
(package-native-search-paths packages:guile-2.0))))
(entry -> (package->manifest-entry guile))
(drv (profile-derivation (manifest (list entry))
- #:hooks '()))
+ #:hooks '()
+ #:locales? #f))
(profile -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
(manifest-entry-search-paths
(package->manifest-entry mpl)))))
+(test-equal "packages->manifest, propagated inputs"
+ (map (match-lambda
+ ((label package)
+ (list (package-name package) (package-version package)
+ package)))
+ (package-propagated-inputs packages:guile-2.2))
+ (map (lambda (entry)
+ (list (manifest-entry-name entry)
+ (manifest-entry-version entry)
+ (manifest-entry-item entry)))
+ (manifest-entry-dependencies
+ (package->manifest-entry packages:guile-2.2))))
+
+(test-assert "manifest-entry-parent"
+ (let ((entry (package->manifest-entry packages:guile-2.2)))
+ (match (manifest-entry-dependencies entry)
+ ((dependencies ..1)
+ (and (every (lambda (parent)
+ (eq? entry (force parent)))
+ (map manifest-entry-parent dependencies))
+ (not (force (manifest-entry-parent entry))))))))
+
+(test-assertm "read-manifest"
+ (mlet* %store-monad ((manifest -> (packages->manifest
+ (list (package
+ (inherit %bootstrap-guile)
+ (native-search-paths
+ (package-native-search-paths
+ packages:guile-2.0))))))
+ (drv (profile-derivation manifest
+ #:hooks '()
+ #:locales? #f))
+ (out -> (derivation->output-path drv)))
+ (define (entry->sexp entry)
+ (list (manifest-entry-name entry)
+ (manifest-entry-version entry)
+ (manifest-entry-search-paths entry)
+ (manifest-entry-dependencies entry)
+ (force (manifest-entry-parent entry))))
+
+ (mbegin %store-monad
+ (built-derivations (list drv))
+ (let ((manifest2 (profile-manifest out)))
+ (return (equal? (map entry->sexp (manifest-entries manifest))
+ (map entry->sexp (manifest-entries manifest2))))))))
+
(test-assertm "etc/profile"
;; Make sure we get an 'etc/profile' file that at least defines $PATH.
(mlet* %store-monad
(package-native-search-paths packages:guile-2.0))))
(entry -> (package->manifest-entry guile))
(drv (profile-derivation (manifest (list entry))
- #:hooks '()))
+ #:hooks '()
+ #:locales? #f))
(profile -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
(display "foo!" port))))))))
(entry -> (package->manifest-entry thing))
(drv (profile-derivation (manifest (list entry))
- #:hooks '()))
+ #:hooks '()
+ #:locales? #f))
(profile -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
(display "foo!" port))))))))
(entry -> (package->manifest-entry thing))
(drv (profile-derivation (manifest (list entry))
- #:hooks '()))
+ #:hooks '()
+ #:locales? #f))
(profile -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
get-string-all)
"foo!"))))))
-(test-end "profiles")
+(test-equalm "union vs. dangling symlink" ;<https://bugs.gnu.org/26949>
+ "does-not-exist"
+ (mlet* %store-monad
+ ((thing1 -> (dummy-package "dummy"
+ (build-system trivial-build-system)
+ (arguments
+ `(#:guile ,%bootstrap-guile
+ #:builder
+ (let ((out (assoc-ref %outputs "out")))
+ (mkdir out)
+ (symlink "does-not-exist"
+ (string-append out "/dangling"))
+ #t)))))
+ (thing2 -> (package (inherit thing1) (name "dummy2")))
+ (drv (profile-derivation (packages->manifest
+ (list thing1 thing2))
+ #:hooks '()
+ #:locales? #f))
+ (profile -> (derivation->output-path drv)))
+ (mbegin %store-monad
+ (built-derivations (list drv))
+ (return (readlink (readlink (string-append profile "/dangling")))))))
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
+(test-end "profiles")
;;; Local Variables:
;;; eval: (put 'dummy-package 'scheme-indent-function 1)
HCoop / jackhill / guix / guix.git / blobdiff