diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-04-04 00:00:41 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-04-04 00:10:00 +0200 |
| commit | 76c486196f299716be33df86d06b3ce2b79dd77f (patch) | |
| tree | 660452112c065299779ab5aaab5ff6416c7fb316 | |
| parent | 3e43166ffc11fb117c55da594e57866a75625900 (diff) | |
packages: Catch invalid input errors for structs.
Reported by Thomas Sigurdsen <thomas.sigurdsen@gmail.com>
at <https://lists.gnu.org/archive/html/help-guix/2017-04/msg00007.html>.
* guix/packages.scm (expand-input): Add 'guard' form around call to
'package-source-derivation'.
* tests/packages.scm (dummy): New test.
| -rw-r--r-- | guix/packages.scm | 12 | ||||
| -rw-r--r-- | tests/packages.scm | 8 |
2 files changed, 18 insertions, 2 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index 61171b8342c..b68b3de6d23 100644 --- a/guix/packages.scm +++ b/guix/packages.scm | |||
| @@ -31,7 +31,6 @@ | |||
| 31 | #:use-module (guix memoization) | 31 | #:use-module (guix memoization) |
| 32 | #:use-module (guix build-system) | 32 | #:use-module (guix build-system) |
| 33 | #:use-module (guix search-paths) | 33 | #:use-module (guix search-paths) |
| 34 | #:use-module (guix gexp) | ||
| 35 | #:use-module (guix sets) | 34 | #:use-module (guix sets) |
| 36 | #:use-module (ice-9 match) | 35 | #:use-module (ice-9 match) |
| 37 | #:use-module (ice-9 vlist) | 36 | #:use-module (ice-9 vlist) |
| @@ -846,7 +845,16 @@ information in exceptions." | |||
| 846 | ;; source. | 845 | ;; source. |
| 847 | (list name (intern file))) | 846 | (list name (intern file))) |
| 848 | (((? string? name) (? struct? source)) | 847 | (((? string? name) (? struct? source)) |
| 849 | (list name (package-source-derivation store source system))) | 848 | ;; 'package-source-derivation' calls 'lower-object', which can throw |
| 849 | ;; '&gexp-input-error'. However '&gexp-input-error' lacks source | ||
| 850 | ;; location info, so we catch and rethrow here (XXX: not optimal | ||
| 851 | ;; performance-wise). | ||
| 852 | (guard (c ((gexp-input-error? c) | ||
| 853 | (raise (condition | ||
| 854 | (&package-input-error | ||
| 855 | (package package) | ||
| 856 | (input (gexp-error-invalid-input c))))))) | ||
| 857 | (list name (package-source-derivation store source system)))) | ||
| 850 | (x | 858 | (x |
| 851 | (raise (condition (&package-input-error | 859 | (raise (condition (&package-input-error |
| 852 | (package package) | 860 | (package package) |
diff --git a/tests/packages.scm b/tests/packages.scm index aa297588303..51dc1ba2b0c 100644 --- a/tests/packages.scm +++ b/tests/packages.scm | |||
| @@ -470,6 +470,14 @@ | |||
| 470 | (package-derivation %store p) | 470 | (package-derivation %store p) |
| 471 | #f))) | 471 | #f))) |
| 472 | 472 | ||
| 473 | (let ((dummy (dummy-package "foo" (inputs `(("x" ,(current-module))))))) | ||
| 474 | (test-equal "&package-input-error" | ||
| 475 | (list dummy (current-module)) | ||
| 476 | (guard (c ((package-input-error? c) | ||
| 477 | (list (package-error-package c) | ||
| 478 | (package-error-invalid-input c)))) | ||
| 479 | (package-derivation %store dummy)))) | ||
| 480 | |||
| 473 | (test-assert "reference to non-existent output" | 481 | (test-assert "reference to non-existent output" |
| 474 | ;; See <http://bugs.gnu.org/19630>. | 482 | ;; See <http://bugs.gnu.org/19630>. |
| 475 | (parameterize ((%graft? #f)) | 483 | (parameterize ((%graft? #f)) |
