03/04: packages: Catch invalid input errors for structs.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 76c486196f299716be33df86d06b3ce2b79dd77f
Author: Ludovic Courtès <address@hidden>
Date:   Tue Apr 4 00:00:41 2017 +0200

    packages: Catch invalid input errors for structs.
    
    Reported by Thomas Sigurdsen <address@hidden>
    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.
---
 guix/packages.scm  | 12 ++++++++++--
 tests/packages.scm |  8 ++++++++
 2 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index 61171b8..b68b3de 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -31,7 +31,6 @@
   #:use-module (guix memoization)
   #:use-module (guix build-system)
   #:use-module (guix search-paths)
-  #:use-module (guix gexp)
   #:use-module (guix sets)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
@@ -846,7 +845,16 @@ information in exceptions."
      ;; source.
      (list name (intern file)))
     (((? string? name) (? struct? source))
-     (list name (package-source-derivation store source system)))
+     ;; 'package-source-derivation' calls 'lower-object', which can throw
+     ;; '&gexp-input-error'.  However '&gexp-input-error' lacks source
+     ;; location info, so we catch and rethrow here (XXX: not optimal
+     ;; performance-wise).
+     (guard (c ((gexp-input-error? c)
+                (raise (condition
+                        (&package-input-error
+                         (package package)
+                         (input   (gexp-error-invalid-input c)))))))
+       (list name (package-source-derivation store source system))))
     (x
      (raise (condition (&package-input-error
                         (package package)
diff --git a/tests/packages.scm b/tests/packages.scm
index aa29758..51dc1ba 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -470,6 +470,14 @@
       (package-derivation %store p)
       #f)))
 
+(let ((dummy (dummy-package "foo" (inputs `(("x" ,(current-module)))))))
+  (test-equal "&package-input-error"
+    (list dummy (current-module))
+    (guard (c ((package-input-error? c)
+               (list (package-error-package c)
+                     (package-error-invalid-input c))))
+      (package-derivation %store dummy))))
+
 (test-assert "reference to non-existent output"
   ;; See <http://bugs.gnu.org/19630>.
   (parameterize ((%graft? #f))