From 5239f3d90841de767c86d0f3a7975b8d799d583d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 6 Sep 2016 22:28:12 +0200 Subject: guix package: Build up the transaction incrementally. * guix/scripts/package.scm (upgraded-manifest-entry): Rename to... (transaction-upgrade-entry): ... this. Add 'transaction' parameter and return a transaction. (options->installable): Likewise. [to-upgrade]: Rename to... [upgraded]: ... this, and change to be a transaction. Return a transaction. (options->removable): Likewise. (process-actions): Adjust accordingly. * tests/packages.scm ("transaction-upgrade-entry, zero upgrades") ("transaction-upgrade-entry, one upgrade"): New tests. --- tests/packages.scm | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) (limited to 'tests/packages.scm') diff --git a/tests/packages.scm b/tests/packages.scm index daceea5d62..456e691962 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -49,6 +49,7 @@ #:use-module (srfi srfi-35) #:use-module (srfi srfi-64) #:use-module (rnrs io ports) + #:use-module (ice-9 vlist) #:use-module (ice-9 regex) #:use-module (ice-9 match)) @@ -83,6 +84,34 @@ (and (hidden-package? (hidden-package (dummy-package "foo"))) (not (hidden-package? (dummy-package "foo"))))) +(test-assert "transaction-upgrade-entry, zero upgrades" + (let* ((old (dummy-package "foo" (version "1"))) + (tx (mock ((gnu packages) find-newest-available-packages + (const vlist-null)) + ((@@ (guix scripts package) transaction-upgrade-entry) + (manifest-entry + (inherit (package->manifest-entry old)) + (item (string-append (%store-prefix) "/" + (make-string 32 #\e) "-foo-1"))) + (manifest-transaction))))) + (manifest-transaction-null? tx))) + +(test-assert "transaction-upgrade-entry, one upgrade" + (let* ((old (dummy-package "foo" (version "1"))) + (new (dummy-package "foo" (version "2"))) + (tx (mock ((gnu packages) find-newest-available-packages + (const (vhash-cons "foo" (list "2" new) vlist-null))) + ((@@ (guix scripts package) transaction-upgrade-entry) + (manifest-entry + (inherit (package->manifest-entry old)) + (item (string-append (%store-prefix) "/" + (make-string 32 #\e) "-foo-1"))) + (manifest-transaction))))) + (and (match (manifest-transaction-install tx) + ((($ "foo" "2" "out" item)) + (eq? item new))) + (null? (manifest-transaction-remove tx))))) + (test-assert "package-field-location" (let () (define (goto port line column) -- cgit v1.2.3 From 01afdab89c6a91f4cd05d3c4f4ff95a0402703eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 6 Sep 2016 23:14:07 +0200 Subject: packages: Add 'package-superseded' and associated support. This provides a way to mark a package as superseded by another one. Upgrades replace superseded packages with their replacement. * guix/packages.scm (package-superseded, deprecated-package): New procedures. * gnu/packages.scm (%find-package): Check for 'package-superseded'. * guix/scripts/package.scm (transaction-upgrade-entry)[supersede]: New procedure. Call it when 'package-superseded' is true. * tests/guix-build.sh: Add test for a superseded package. * tests/packages.scm ("package-superseded") ("transaction-upgrade-entry, superseded package"): New tests. --- tests/packages.scm | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) (limited to 'tests/packages.scm') diff --git a/tests/packages.scm b/tests/packages.scm index 456e691962..b8e1f111cd 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -84,6 +84,15 @@ (and (hidden-package? (hidden-package (dummy-package "foo"))) (not (hidden-package? (dummy-package "foo"))))) +(test-assert "package-superseded" + (let* ((new (dummy-package "bar")) + (old (deprecated-package "foo" new))) + (and (eq? (package-superseded old) new) + (mock ((gnu packages) find-best-packages-by-name (const (list old))) + (specification->package "foo") + (and (eq? new (specification->package "foo")) + (eq? new (specification->package+output "foo"))))))) + (test-assert "transaction-upgrade-entry, zero upgrades" (let* ((old (dummy-package "foo" (version "1"))) (tx (mock ((gnu packages) find-newest-available-packages @@ -112,6 +121,27 @@ (eq? item new))) (null? (manifest-transaction-remove tx))))) +(test-assert "transaction-upgrade-entry, superseded package" + (let* ((old (dummy-package "foo" (version "1"))) + (new (dummy-package "bar" (version "2"))) + (dep (deprecated-package "foo" new)) + (tx (mock ((gnu packages) find-newest-available-packages + (const (vhash-cons "foo" (list "2" dep) vlist-null))) + ((@@ (guix scripts package) transaction-upgrade-entry) + (manifest-entry + (inherit (package->manifest-entry old)) + (item (string-append (%store-prefix) "/" + (make-string 32 #\e) "-foo-1"))) + (manifest-transaction))))) + (and (match (manifest-transaction-install tx) + ((($ "bar" "2" "out" item)) + (eq? item new))) + (match (manifest-transaction-remove tx) + (((? manifest-pattern? pattern)) + (and (string=? (manifest-pattern-name pattern) "foo") + (string=? (manifest-pattern-version pattern) "1") + (string=? (manifest-pattern-output pattern) "out"))))))) + (test-assert "package-field-location" (let () (define (goto port line column) -- cgit v1.2.3