mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
profiles: 'package->manifest-entry' preserves transformations by default.
Previously, transformations applied from a manifest (rather than via "guix install") would be lost. This change fixes that and simplifies things. Reported by zimoun at <https://lists.gnu.org/archive/html/guix-devel/2021-02/msg00153.html>. * guix/profiles.scm (default-properties): New procedure. (package->manifest-entry): Use it for #:properties. * guix/scripts/pack.scm (guix-pack)[with-transformations]: Remove. Remove caller. * guix/scripts/package.scm (transaction-upgrade-entry): Remove calls to 'manifest-entry-with-transformations'. * tests/guix-package.sh: Add test. * tests/transformations.scm ("options->transformation + package->manifest-entry"): New test.
This commit is contained in:
parent
c9d42d611c
commit
90ea8b16eb
5 changed files with 48 additions and 23 deletions
|
@ -362,9 +362,16 @@ file name."
|
||||||
#t
|
#t
|
||||||
lst)))
|
lst)))
|
||||||
|
|
||||||
|
(define (default-properties package)
|
||||||
|
"Return the default properties of a manifest entry for PACKAGE."
|
||||||
|
;; Preserve transformation options by default.
|
||||||
|
(match (assq-ref (package-properties package) 'transformations)
|
||||||
|
(#f '())
|
||||||
|
(transformations `((transformations . ,transformations)))))
|
||||||
|
|
||||||
(define* (package->manifest-entry package #:optional (output "out")
|
(define* (package->manifest-entry package #:optional (output "out")
|
||||||
#:key (parent (delay #f))
|
#:key (parent (delay #f))
|
||||||
(properties '()))
|
(properties (default-properties package)))
|
||||||
"Return a manifest entry for the OUTPUT of package PACKAGE."
|
"Return a manifest entry for the OUTPUT of package PACKAGE."
|
||||||
;; For each dependency, keep a promise pointing to its "parent" entry.
|
;; For each dependency, keep a promise pointing to its "parent" entry.
|
||||||
(letrec* ((deps (map (match-lambda
|
(letrec* ((deps (map (match-lambda
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2015, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
|
;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
|
||||||
;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
|
;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net>
|
||||||
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
|
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
|
||||||
|
@ -1170,12 +1170,7 @@ Create a bundle of PACKAGE.\n"))
|
||||||
manifest))
|
manifest))
|
||||||
identity))
|
identity))
|
||||||
|
|
||||||
(define (with-transformations manifest)
|
|
||||||
(map-manifest-entries manifest-entry-with-transformations
|
|
||||||
manifest))
|
|
||||||
|
|
||||||
(with-provenance
|
(with-provenance
|
||||||
(with-transformations
|
|
||||||
(cond
|
(cond
|
||||||
((and (not (null? manifests)) (not (null? packages)))
|
((and (not (null? manifests)) (not (null? packages)))
|
||||||
(leave (G_ "both a manifest and a package list were given~%")))
|
(leave (G_ "both a manifest and a package list were given~%")))
|
||||||
|
@ -1187,7 +1182,7 @@ Create a bundle of PACKAGE.\n"))
|
||||||
(load* file user-module)))
|
(load* file user-module)))
|
||||||
manifests)))
|
manifests)))
|
||||||
(else
|
(else
|
||||||
(packages->manifest packages)))))))
|
(packages->manifest packages))))))
|
||||||
|
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
(with-store store
|
(with-store store
|
||||||
|
|
|
@ -235,14 +235,12 @@ non-zero relevance score."
|
||||||
(case (version-compare candidate-version version)
|
(case (version-compare candidate-version version)
|
||||||
((>)
|
((>)
|
||||||
(manifest-transaction-install-entry
|
(manifest-transaction-install-entry
|
||||||
(manifest-entry-with-transformations
|
(package->manifest-entry* pkg output)
|
||||||
(package->manifest-entry* pkg output))
|
|
||||||
transaction))
|
transaction))
|
||||||
((<)
|
((<)
|
||||||
transaction)
|
transaction)
|
||||||
((=)
|
((=)
|
||||||
(let* ((new (manifest-entry-with-transformations
|
(let* ((new (package->manifest-entry* pkg output)))
|
||||||
(package->manifest-entry* pkg output))))
|
|
||||||
;; Here we want to determine whether the NEW actually
|
;; Here we want to determine whether the NEW actually
|
||||||
;; differs from ENTRY, but we need to intercept
|
;; differs from ENTRY, but we need to intercept
|
||||||
;; 'build-things' calls because they would prevent us from
|
;; 'build-things' calls because they would prevent us from
|
||||||
|
|
|
@ -386,6 +386,21 @@ guix package -I
|
||||||
# '--dry-run' is passed.
|
# '--dry-run' is passed.
|
||||||
GUIX_BUILD_OPTIONS="--no-grafts"
|
GUIX_BUILD_OPTIONS="--no-grafts"
|
||||||
|
|
||||||
|
# Install using the "imperative model", export a manifest, instantiate it, and
|
||||||
|
# make sure we get the same profile.
|
||||||
|
guix package --bootstrap -i guile-bootstrap --without-tests=foo
|
||||||
|
profile_directory="$(readlink -f "$default_profile")"
|
||||||
|
guix package --export-manifest > "$tmpfile"
|
||||||
|
grep 'without-tests.*foo' "$tmpfile"
|
||||||
|
guix package --rollback --bootstrap
|
||||||
|
guix package --bootstrap -m "$tmpfile"
|
||||||
|
test "$(readlink -f "$default_profile")" = "$profile_directory"
|
||||||
|
guix package --export-manifest > "$tmpfile.2nd"
|
||||||
|
cmp "$tmpfile" "$tmpfile.2nd"
|
||||||
|
|
||||||
|
rm -f "$tmpfile.2nd"
|
||||||
|
guix package --rollback --bootstrap
|
||||||
|
|
||||||
# Applying a manifest file.
|
# Applying a manifest file.
|
||||||
cat > "$module_dir/manifest.scm"<<EOF
|
cat > "$module_dir/manifest.scm"<<EOF
|
||||||
(use-package-modules bootstrap)
|
(use-package-modules bootstrap)
|
||||||
|
|
|
@ -20,6 +20,9 @@
|
||||||
#:use-module (guix tests)
|
#:use-module (guix tests)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module ((guix gexp) #:select (lower-object))
|
#:use-module ((guix gexp) #:select (lower-object))
|
||||||
|
#:use-module ((guix profiles)
|
||||||
|
#:select (package->manifest-entry
|
||||||
|
manifest-entry-properties))
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix git-download)
|
#:use-module (guix git-download)
|
||||||
|
@ -413,6 +416,13 @@
|
||||||
`((with-latest . "foo")))))
|
`((with-latest . "foo")))))
|
||||||
(package-version (t p)))))
|
(package-version (t p)))))
|
||||||
|
|
||||||
|
(test-equal "options->transformation + package->manifest-entry"
|
||||||
|
'((transformations . ((without-tests . "foo"))))
|
||||||
|
(let* ((p (dummy-package "foo"))
|
||||||
|
(t (options->transformation '((without-tests . "foo"))))
|
||||||
|
(e (package->manifest-entry (t p))))
|
||||||
|
(manifest-entry-properties e)))
|
||||||
|
|
||||||
(test-end)
|
(test-end)
|
||||||
|
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue