;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;;
;;; This file is part of GNU Guix.
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
- #:use-module (guix grafts)
#:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix build-system trivial)
(manifest-matching-entries m (list p))
#f)))
+(test-equal "concatenate-manifests"
+ (manifest (list guile-2.0.9 glibc))
+ (concatenate-manifests (list (manifest (list guile-2.0.9))
+ (manifest (list glibc)))))
+
(test-assert "manifest-remove"
(let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
(m1 (manifest-remove m0
(manifest-entries (manifest-add (manifest '())
(list guile-2.0.9 guile-2.0.9))))
+(test-equal "manifest->code, simple"
+ '(begin
+ (specifications->manifest (list "guile" "guile:debug" "glibc")))
+ (manifest->code (manifest (list guile-2.0.9 guile-2.0.9:debug glibc))))
+
+(test-equal "manifest->code, simple, versions"
+ '(begin
+ (specifications->manifest (list "guile@2.0.9" "guile@2.0.9:debug"
+ "glibc@2.19")))
+ (manifest->code (manifest (list guile-2.0.9 guile-2.0.9:debug glibc))
+ #:entry-package-version manifest-entry-version))
+
+(test-equal "manifest->code, transformations"
+ '(begin
+ (use-modules (guix transformations))
+
+ (define transform1
+ (options->transformation '((foo . "bar"))))
+
+ (packages->manifest
+ (list (transform1 (specification->package "guile"))
+ (specification->package "glibc"))))
+ (manifest->code (manifest (list (manifest-entry
+ (inherit guile-2.0.9)
+ (properties `((transformations
+ . ((foo . "bar"))))))
+ glibc))))
+
(test-assert "manifest-perform-transaction"
(let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
(t1 (manifest-transaction
(equal? (list glibc) install)
(equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade)))))
+(test-assert "manifest-transaction-effects no double install or upgrades"
+ (let* ((m0 (manifest (list guile-1.8.8)))
+ (t (manifest-transaction
+ (install (list guile-2.0.9 glibc glibc)))))
+ (let-values (((remove install upgrade downgrade)
+ (manifest-transaction-effects m0 t)))
+ (and (null? remove) (null? downgrade)
+ (equal? (list glibc) install)
+ (equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade)))))
+
(test-assert "manifest-transaction-effects and downgrades"
(let* ((m0 (manifest (list guile-2.0.9)))
(t (manifest-transaction (install (list guile-1.8.8)))))
(and (null? remove) (null? install) (null? upgrade)
(equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade)))))
+(test-assert "manifest-transaction-effects no double downgrade"
+ (let* ((m0 (manifest (list guile-2.0.9)))
+ (t (manifest-transaction (install (list guile-1.8.8 guile-1.8.8)))))
+ (let-values (((remove install upgrade downgrade)
+ (manifest-transaction-effects m0 t)))
+ (and (null? remove) (null? install) (null? upgrade)
+ (equal? (list (cons guile-2.0.9 guile-1.8.8)) downgrade)))))
+
(test-assert "manifest-transaction-effects and pseudo-upgrades"
(let* ((m0 (manifest (list guile-2.0.9)))
(t (manifest-transaction (install (list guile-2.0.9)))))
(and (manifest-transaction-removal-candidate? guile-2.0.9 t)
(not (manifest-transaction-removal-candidate? glibc t)))))
+(test-assert "manifest-transaction-effects no double removal"
+ (let* ((m0 (manifest (list guile-2.0.9)))
+ (t (manifest-transaction
+ (remove (list (manifest-pattern (name "guile")))))))
+ (let-values (((remove install upgrade downgrade)
+ (manifest-transaction-effects m0 t)))
+ (and (= 1 (length remove))
+ (manifest-transaction-removal-candidate? guile-2.0.9 t)
+ (null? install) (null? downgrade) (null? upgrade)))))
+
+(test-assert "package->development-manifest"
+ (let ((manifest (package->development-manifest packages:hello)))
+ (every (lambda (name)
+ (manifest-installed? manifest
+ (manifest-pattern (name name))))
+ '("gcc" "binutils" "glibc" "coreutils" "grep" "sed"))))
+
(test-assertm "profile-derivation"
(mlet* %store-monad
((entry -> (package->manifest-entry %bootstrap-guile))
(string=? (dirname (readlink bindir))
(derivation->output-path guile))))))
+(test-assertm "profile-derivation format version 3"
+ ;; Make sure we can create and read a version 3 manifest.
+ (mlet* %store-monad
+ ((entry -> (package->manifest-entry %bootstrap-guile
+ #:properties '((answer . 42))))
+ (manifest -> (manifest (list entry)))
+ (drv1 (profile-derivation manifest
+ #:format-version 3 ;old version
+ #:hooks '()
+ #:locales? #f))
+ (drv2 (profile-derivation manifest
+ #:hooks '()
+ #:locales? #f))
+ (profile1 -> (derivation->output-path drv1))
+ (profile2 -> (derivation->output-path drv2))
+ (_ (built-derivations (list drv1 drv2))))
+ (return (let ((manifest1 (profile-manifest profile1))
+ (manifest2 (profile-manifest profile2)))
+ (match (manifest-entries manifest1)
+ ((entry1)
+ (match (manifest-entries manifest2)
+ ((entry2)
+ (and (manifest-entry=? entry1 entry2)
+ (equal? (manifest-entry-properties entry1)
+ '((answer . 42)))
+ (equal? (manifest-entry-properties entry2)
+ '((answer . 42))))))))))))
+
+(test-assertm "profile-derivation, ordering & collisions"
+ ;; ENTRY1 and ENTRY2 both provide 'bin/guile'--a collision. Make sure
+ ;; ENTRY1 "wins" over ENTRY2. See <https://bugs.gnu.org/49102>.
+ (mlet* %store-monad
+ ((entry1 -> (package->manifest-entry %bootstrap-guile))
+ (entry2 -> (manifest-entry
+ (name "fake-guile")
+ (version "0")
+ (item (computed-file
+ "fake-guile"
+ #~(begin
+ (mkdir #$output)
+ (mkdir (string-append #$output "/bin"))
+ (call-with-output-file
+ (string-append #$output "/bin/guile")
+ (lambda (port)
+ (display "Fake!\n" port))))
+ #:guile %bootstrap-guile))))
+ (guile (package->derivation %bootstrap-guile))
+ (drv (profile-derivation (manifest (list entry1 entry2))
+ #:hooks '()
+ #:locales? #f))
+ (profile -> (derivation->output-path drv))
+ (bindir -> (string-append profile "/bin"))
+ (file -> (string-append bindir "/guile"))
+ (_ (built-derivations (list drv))))
+ (return (string=? (readlink file)
+ (string-append
+ (derivation->output-path guile)
+ "/bin/guile")))))
+
+(test-assertm "load-profile"
+ (mlet* %store-monad
+ ((entry -> (package->manifest-entry %bootstrap-guile))
+ (guile (package->derivation %bootstrap-guile))
+ (drv (profile-derivation (manifest (list entry))
+ #:hooks '()
+ #:locales? #f))
+ (profile -> (derivation->output-path drv))
+ (bindir -> (string-append profile "/bin"))
+ (_ (built-derivations (list drv))))
+ (define-syntax-rule (with-environment-excursion exp ...)
+ (let ((env (environ)))
+ (dynamic-wind
+ (const #t)
+ (lambda () exp ...)
+ (lambda () (environ env)))))
+
+ (return (and (with-environment-excursion
+ (load-profile profile)
+ (and (string-prefix? (string-append bindir ":")
+ (getenv "PATH"))
+ (getenv "GUILE_LOAD_PATH")))
+ (with-environment-excursion
+ (load-profile profile #:pure? #t #:white-list '())
+ (equal? (list (string-append "PATH=" bindir))
+ (environ)))))))
+
+(test-assertm "<profile>"
+ (mlet* %store-monad
+ ((entry -> (package->manifest-entry %bootstrap-guile))
+ (profile -> (profile (hooks '()) (locales? #f)
+ (content (manifest (list entry)))))
+ (drv (lower-object profile))
+ (profile -> (derivation->output-path drv))
+ (bindir -> (string-append profile "/bin"))
+ (_ (built-derivations (list drv))))
+ (return (file-exists? (string-append bindir "/guile")))))
+
(test-assertm "profile-derivation relative symlinks, one entry"
(mlet* %store-monad
((entry -> (package->manifest-entry %bootstrap-guile))
(test-assert "package->manifest-entry, search paths"
;; See <http://bugs.gnu.org/22073>.
- (let ((mpl (@ (gnu packages python-xyz) python2-matplotlib)))
+ (let ((mpl (@ (gnu packages python-xyz) python-matplotlib)))
(lset= eq?
(package-transitive-native-search-paths mpl)
(manifest-entry-search-paths
(package->manifest-entry mpl)))))
+(test-assert "packages->manifest, no duplicates"
+ (let ((expected
+ (manifest
+ (list
+ (package->manifest-entry packages:guile-2.2))))
+ (manifest (packages->manifest
+ (list packages:guile-2.2 packages:guile-2.2))))
+ (every manifest-entry=? (manifest-entries expected)
+ (manifest-entries manifest))))
+
(test-equal "packages->manifest, propagated inputs"
(map (match-lambda
((label package)
(return #f)))))
(test-equal "collision of propagated inputs"
- '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42"))
+ '(("guile-bootstrap" "2.0") "p1"
+ <> ("guile-bootstrap" "42") "p2")
(guard (c ((profile-collision-error? c)
(let ((entry1 (profile-collision-error-entry c))
(entry2 (profile-collision-error-conflict c)))
(list (list (manifest-entry-name entry1)
(manifest-entry-version entry1))
+ (manifest-entry-name
+ (force (manifest-entry-parent entry1)))
+ '<>
(list (manifest-entry-name entry2)
- (manifest-entry-version entry2))))))
+ (manifest-entry-version entry2))
+ (manifest-entry-name
+ (force (manifest-entry-parent entry2)))))))
(run-with-store %store
(mlet* %store-monad ((p0 -> (package
(inherit %bootstrap-guile)
#:locales? #f)))
(return #f)))))
+(test-assertm "deduplication of repeated entries"
+ ;; Make sure the 'manifest' file does not duplicate identical entries.
+ ;; See <https://issues.guix.gnu.org/55499>.
+ (mlet* %store-monad ((p0 -> (dummy-package "p0"
+ (build-system trivial-build-system)
+ (arguments
+ `(#:guile ,%bootstrap-guile
+ #:builder (mkdir (assoc-ref %outputs "out"))))
+ (propagated-inputs
+ `(("guile" ,%bootstrap-guile)))))
+ (p1 -> (package
+ (inherit p0)
+ (name "p1")))
+ (drv (profile-derivation (packages->manifest
+ (list p0 p1))
+ #:hooks '()
+ #:locales? #f)))
+ (mbegin %store-monad
+ (built-derivations (list drv))
+ (let ((file (string-append (derivation->output-path drv)
+ "/manifest"))
+ (manifest (profile-manifest (derivation->output-path drv))))
+ (define (contains-repeated? sexp)
+ (match sexp
+ (('repeated _ ...) #t)
+ ((lst ...) (any contains-repeated? sexp))
+ (_ #f)))
+
+ (return (and (contains-repeated? (call-with-input-file file read))
+
+ ;; MANIFEST has two entries for %BOOTSTRAP-GUILE since
+ ;; it's propagated both from P0 and from P1. When
+ ;; reading a 'repeated' node, 'read-manifest' should
+ ;; reuse the previously-read entry so the two
+ ;; %BOOTSTRAP-GUILE entries must be 'eq?'.
+ (match (manifest-entries manifest)
+ (((= manifest-entry-dependencies (dep0))
+ (= manifest-entry-dependencies (dep1)))
+ (and (string=? (manifest-entry-name dep0)
+ (package-name %bootstrap-guile))
+ (eq? dep0 dep1))))))))))
+
(test-assertm "no collision"
;; Here we have an entry that is "lowered" (its 'item' field is a store file
;; name) and another entry (its 'item' field is a package) that is
HCoop / jackhill / guix / guix.git / blobdiff