aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/packages.scm9
-rw-r--r--guix/packages.scm14
-rw-r--r--guix/scripts/package.scm46
-rw-r--r--tests/guix-build.sh6
-rw-r--r--tests/packages.scm30
5 files changed, 89 insertions, 16 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 68a9eef2ad..5d60423a3a 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -305,7 +305,14 @@ return its return value."
(when fallback?
(warning (_ "deprecated NAME-VERSION syntax; \
use NAME@VERSION instead~%")))
- pkg)
+
+ (match (package-superseded pkg)
+ ((? package? new)
+ (info (_ "package '~a' has been superseded by '~a'~%")
+ (package-name pkg) (package-name new))
+ new)
+ (#f
+ pkg)))
(_
(if version
(leave (_ "~A: package not found for version ~a~%") name version)
diff --git a/guix/packages.scm b/guix/packages.scm
index d544c34cf8..afbafc70a7 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -83,6 +83,8 @@
package-location
hidden-package
hidden-package?
+ package-superseded
+ deprecated-package
package-field-location
package-direct-sources
@@ -306,6 +308,18 @@ user interfaces, ignores."
interfaces."
(assoc-ref (package-properties p) 'hidden?))
+(define (package-superseded p)
+ "Return the package the supersedes P, or #f if P is still current."
+ (assoc-ref (package-properties p) 'superseded))
+
+(define (deprecated-package old-name p)
+ "Return a package called OLD-NAME and marked as superseded by P, a package
+object."
+ (package
+ (inherit p)
+ (name old-name)
+ (properties `((superseded . ,p)))))
+
(define (package-field-location package field)
"Return the source code location of the definition of FIELD for PACKAGE, or
#f if it could not be determined."
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index dc5fcba922..b87aee0be9 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -264,25 +264,41 @@ synopsis or description matches all of REGEXPS."
(define (transaction-upgrade-entry entry transaction)
"Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a
<manifest-entry>."
+ (define (supersede old new)
+ (info (_ "package '~a' has been superseded by '~a'~%")
+ (manifest-entry-name old) (package-name new))
+ (manifest-transaction-install-entry
+ (package->manifest-entry new (manifest-entry-output old))
+ (manifest-transaction-remove-pattern
+ (manifest-pattern
+ (name (manifest-entry-name old))
+ (version (manifest-entry-version old))
+ (output (manifest-entry-output old)))
+ transaction)))
+
(match entry
(($ <manifest-entry> name version output (? string? path))
(match (vhash-assoc name (find-newest-available-packages))
((_ candidate-version pkg . rest)
- (case (version-compare candidate-version version)
- ((>)
- (manifest-transaction-install-entry
- (package->manifest-entry pkg output)
- transaction))
- ((<)
- transaction)
- ((=)
- (let ((candidate-path (derivation->output-path
- (package-derivation (%store) pkg))))
- (if (string=? path candidate-path)
- transaction
- (manifest-transaction-install-entry
- (package->manifest-entry pkg output)
- transaction))))))
+ (match (package-superseded pkg)
+ ((? package? new)
+ (supersede entry new))
+ (#f
+ (case (version-compare candidate-version version)
+ ((>)
+ (manifest-transaction-install-entry
+ (package->manifest-entry pkg output)
+ transaction))
+ ((<)
+ transaction)
+ ((=)
+ (let ((candidate-path (derivation->output-path
+ (package-derivation (%store) pkg))))
+ (if (string=? path candidate-path)
+ transaction
+ (manifest-transaction-install-entry
+ (package->manifest-entry pkg output)
+ transaction))))))))
(#f
transaction)))))
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 6d4f97019a..9e9788bca0 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -93,6 +93,9 @@ cat > "$module_dir/foo.scm"<<EOF
(define-public baz
(dummy-package "baz" (replacement foo)))
+(define-public superseded
+ (deprecated-package "superseded" bar))
+
EOF
GUIX_PACKAGE_PATH="$module_dir"
@@ -168,6 +171,9 @@ test "$drv1" = "$drv2"
if guix build guile --with-input=libunistring=something-really-silly
then false; else true; fi
+# Deprecated/superseded packages.
+test "`guix build superseded -d`" = "`guix build bar -d`"
+
# Parsing package names and versions.
guix build -n time # PASS
guix build -n time@1.7 # PASS, version found
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)
+ ((($ <manifest-entry> "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)