diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2019-06-23 18:28:45 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-06-27 11:14:41 +0200 |
| commit | 066eeae1a197b1926c7ffc42919d684686f56fdb (patch) | |
| tree | 808479f4cf1a18ced524f5a087cbb55af59522b6 | |
| parent | 7c690a47381f645ec5ec0a1fd6ffc34dba1b69c2 (diff) | |
packages: 'specification->package+output' distinguishes "no output specified".
Until now the caller couldn't tell the different between a spec like
"foo:out" and one like "foo". This change allows users to distinguish
between these two cases.
* gnu/packages.scm (specification->package+output): Disable output
membership test when OUTPUT = #f and SUB-DRV = #f.
* tests/packages.scm ("specification->package+output")
("specification->package+output invalid output")
("specification->package+output no default output")
("specification->package+output invalid output, no default"): New tests.
| -rw-r--r-- | gnu/packages.scm | 8 | ||||
| -rw-r--r-- | tests/packages.scm | 32 |
2 files changed, 38 insertions, 2 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm index 48390575ba7..acb247e1144 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm | |||
| @@ -534,14 +534,18 @@ optionally contain a version number and an output name, as in these examples: | |||
| 534 | guile@2.0.9:debug | 534 | guile@2.0.9:debug |
| 535 | 535 | ||
| 536 | If SPEC does not specify a version number, return the preferred newest | 536 | If SPEC does not specify a version number, return the preferred newest |
| 537 | version; if SPEC does not specify an output, return OUTPUT." | 537 | version; if SPEC does not specify an output, return OUTPUT. |
| 538 | |||
| 539 | When OUTPUT is false and SPEC does not specify any output, return #f as the | ||
| 540 | output." | ||
| 538 | (let-values (((name version sub-drv) | 541 | (let-values (((name version sub-drv) |
| 539 | (package-specification->name+version+output spec output))) | 542 | (package-specification->name+version+output spec output))) |
| 540 | (match (%find-package spec name version) | 543 | (match (%find-package spec name version) |
| 541 | (#f | 544 | (#f |
| 542 | (values #f #f)) | 545 | (values #f #f)) |
| 543 | (package | 546 | (package |
| 544 | (if (member sub-drv (package-outputs package)) | 547 | (if (or (and (not output) (not sub-drv)) |
| 548 | (member sub-drv (package-outputs package))) | ||
| 545 | (values package sub-drv) | 549 | (values package sub-drv) |
| 546 | (leave (G_ "package `~a' lacks output `~a'~%") | 550 | (leave (G_ "package `~a' lacks output `~a'~%") |
| 547 | (package-full-name package) | 551 | (package-full-name package) |
diff --git a/tests/packages.scm b/tests/packages.scm index 613b2f1221c..836d446657c 100644 --- a/tests/packages.scm +++ b/tests/packages.scm | |||
| @@ -1227,6 +1227,38 @@ | |||
| 1227 | (lambda (key . args) | 1227 | (lambda (key . args) |
| 1228 | key))) | 1228 | key))) |
| 1229 | 1229 | ||
| 1230 | (test-equal "specification->package+output" | ||
| 1231 | `((,coreutils "out") (,coreutils "debug")) | ||
| 1232 | (list (call-with-values (lambda () | ||
| 1233 | (specification->package+output "coreutils")) | ||
| 1234 | list) | ||
| 1235 | (call-with-values (lambda () | ||
| 1236 | (specification->package+output "coreutils:debug")) | ||
| 1237 | list))) | ||
| 1238 | |||
| 1239 | (test-equal "specification->package+output invalid output" | ||
| 1240 | 'error | ||
| 1241 | (catch 'quit | ||
| 1242 | (lambda () | ||
| 1243 | (specification->package+output "coreutils:does-not-exist")) | ||
| 1244 | (lambda _ | ||
| 1245 | 'error))) | ||
| 1246 | |||
| 1247 | (test-equal "specification->package+output no default output" | ||
| 1248 | `(,coreutils #f) | ||
| 1249 | (call-with-values | ||
| 1250 | (lambda () | ||
| 1251 | (specification->package+output "coreutils" #f)) | ||
| 1252 | list)) | ||
| 1253 | |||
| 1254 | (test-equal "specification->package+output invalid output, no default" | ||
| 1255 | 'error | ||
| 1256 | (catch 'quit | ||
| 1257 | (lambda () | ||
| 1258 | (specification->package+output "coreutils:does-not-exist" #f)) | ||
| 1259 | (lambda _ | ||
| 1260 | 'error))) | ||
| 1261 | |||
| 1230 | (test-equal "find-package-locations" | 1262 | (test-equal "find-package-locations" |
| 1231 | (map (lambda (package) | 1263 | (map (lambda (package) |
| 1232 | (cons (package-version package) | 1264 | (cons (package-version package) |
