diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2016-09-06 23:14:07 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2016-09-06 23:22:10 +0200 |
| commit | 01afdab89c6a91f4cd05d3c4f4ff95a0402703eb (patch) | |
| tree | 7be146245b7b7053532f38476399e5b8f5b2f9c4 /tests | |
| parent | 03763d6473bcd6c7a84bcc3a6aa7bc2d1ee1e44f (diff) | |
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.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/guix-build.sh | 6 | ||||
| -rw-r--r-- | tests/packages.scm | 30 |
2 files changed, 36 insertions, 0 deletions
diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 6d4f97019ab..9e9788bca01 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh | |||
| @@ -93,6 +93,9 @@ cat > "$module_dir/foo.scm"<<EOF | |||
| 93 | (define-public baz | 93 | (define-public baz |
| 94 | (dummy-package "baz" (replacement foo))) | 94 | (dummy-package "baz" (replacement foo))) |
| 95 | 95 | ||
| 96 | (define-public superseded | ||
| 97 | (deprecated-package "superseded" bar)) | ||
| 98 | |||
| 96 | EOF | 99 | EOF |
| 97 | 100 | ||
| 98 | GUIX_PACKAGE_PATH="$module_dir" | 101 | GUIX_PACKAGE_PATH="$module_dir" |
| @@ -168,6 +171,9 @@ test "$drv1" = "$drv2" | |||
| 168 | if guix build guile --with-input=libunistring=something-really-silly | 171 | if guix build guile --with-input=libunistring=something-really-silly |
| 169 | then false; else true; fi | 172 | then false; else true; fi |
| 170 | 173 | ||
| 174 | # Deprecated/superseded packages. | ||
| 175 | test "`guix build superseded -d`" = "`guix build bar -d`" | ||
| 176 | |||
| 171 | # Parsing package names and versions. | 177 | # Parsing package names and versions. |
| 172 | guix build -n time # PASS | 178 | guix build -n time # PASS |
| 173 | guix build -n time@1.7 # PASS, version found | 179 | guix build -n time@1.7 # PASS, version found |
diff --git a/tests/packages.scm b/tests/packages.scm index 456e6919625..b8e1f111cd0 100644 --- a/tests/packages.scm +++ b/tests/packages.scm | |||
| @@ -84,6 +84,15 @@ | |||
| 84 | (and (hidden-package? (hidden-package (dummy-package "foo"))) | 84 | (and (hidden-package? (hidden-package (dummy-package "foo"))) |
| 85 | (not (hidden-package? (dummy-package "foo"))))) | 85 | (not (hidden-package? (dummy-package "foo"))))) |
| 86 | 86 | ||
| 87 | (test-assert "package-superseded" | ||
| 88 | (let* ((new (dummy-package "bar")) | ||
| 89 | (old (deprecated-package "foo" new))) | ||
| 90 | (and (eq? (package-superseded old) new) | ||
| 91 | (mock ((gnu packages) find-best-packages-by-name (const (list old))) | ||
| 92 | (specification->package "foo") | ||
| 93 | (and (eq? new (specification->package "foo")) | ||
| 94 | (eq? new (specification->package+output "foo"))))))) | ||
| 95 | |||
| 87 | (test-assert "transaction-upgrade-entry, zero upgrades" | 96 | (test-assert "transaction-upgrade-entry, zero upgrades" |
| 88 | (let* ((old (dummy-package "foo" (version "1"))) | 97 | (let* ((old (dummy-package "foo" (version "1"))) |
| 89 | (tx (mock ((gnu packages) find-newest-available-packages | 98 | (tx (mock ((gnu packages) find-newest-available-packages |
| @@ -112,6 +121,27 @@ | |||
| 112 | (eq? item new))) | 121 | (eq? item new))) |
| 113 | (null? (manifest-transaction-remove tx))))) | 122 | (null? (manifest-transaction-remove tx))))) |
| 114 | 123 | ||
| 124 | (test-assert "transaction-upgrade-entry, superseded package" | ||
| 125 | (let* ((old (dummy-package "foo" (version "1"))) | ||
| 126 | (new (dummy-package "bar" (version "2"))) | ||
| 127 | (dep (deprecated-package "foo" new)) | ||
| 128 | (tx (mock ((gnu packages) find-newest-available-packages | ||
| 129 | (const (vhash-cons "foo" (list "2" dep) vlist-null))) | ||
| 130 | ((@@ (guix scripts package) transaction-upgrade-entry) | ||
| 131 | (manifest-entry | ||
| 132 | (inherit (package->manifest-entry old)) | ||
| 133 | (item (string-append (%store-prefix) "/" | ||
| 134 | (make-string 32 #\e) "-foo-1"))) | ||
| 135 | (manifest-transaction))))) | ||
| 136 | (and (match (manifest-transaction-install tx) | ||
| 137 | ((($ <manifest-entry> "bar" "2" "out" item)) | ||
| 138 | (eq? item new))) | ||
| 139 | (match (manifest-transaction-remove tx) | ||
| 140 | (((? manifest-pattern? pattern)) | ||
| 141 | (and (string=? (manifest-pattern-name pattern) "foo") | ||
| 142 | (string=? (manifest-pattern-version pattern) "1") | ||
| 143 | (string=? (manifest-pattern-output pattern) "out"))))))) | ||
| 144 | |||
| 115 | (test-assert "package-field-location" | 145 | (test-assert "package-field-location" |
| 116 | (let () | 146 | (let () |
| 117 | (define (goto port line column) | 147 | (define (goto port line column) |
