Browse Source

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.
wip-deploy
Ludovic Courtès 5 years ago
parent
commit
01afdab89c
No known key found for this signature in database GPG Key ID: 90B11993D9AEBB5
  1. 9
      gnu/packages.scm
  2. 14
      guix/packages.scm
  3. 46
      guix/scripts/package.scm
  4. 6
      tests/guix-build.sh
  5. 30
      tests/packages.scm

9
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)

14
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."

46
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)))))

6
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

30
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)

Loading…
Cancel
Save