guix build: Nicely report unbound variables with hints.

* guix/ui.scm (print-unbound-variable-error): Add "error:" to the
message.
(report-unbound-variable-error): New procedure, with code formerly in
'report-load-error'.
(report-load-error): Use it.
(call-with-unbound-variable-handling): New procedure.
(with-unbound-variable-handling): New macro.
* guix/scripts/build.scm (options->derivations): Wrap body in
'with-unbound-variable-handling'.
* tests/guix-build.sh (GUIX_PACKAGE_PATH): Add test.

guix/scripts/build.scm

@@ -661,43 +661,47 @@ (define src    (assoc-ref opts 'source))
   (define system (assoc-ref opts 'system))
   (define graft? (assoc-ref opts 'graft?))
 
-  (parameterize ((%graft? graft?))
+  ;; We may get 'unbound-variable' errors while evaluating the 'inputs' fields
-    (append-map (match-lambda
+  ;; of user packages.  Since 'guix build' is the primary tool for people
-                  ((? package? p)
+  ;; testing new packages, report such errors gracefully.
-                   (let ((p (or (and graft? (package-replacement p)) p)))
+  (with-unbound-variable-handling
-                     (match src
+   (parameterize ((%graft? graft?))
-                       (#f
+     (append-map (match-lambda
-                        (list (package->derivation store p system)))
+                   ((? package? p)
-                       (#t
+                    (let ((p (or (and graft? (package-replacement p)) p)))
-                        (match (package-source p)
+                      (match src
-                          (#f
+                        (#f
-                           (format (current-error-port)
+                         (list (package->derivation store p system)))
-                                   (G_ "~a: warning: \
+                        (#t
+                         (match (package-source p)
+                           (#f
+                            (format (current-error-port)
+                                    (G_ "~a: warning: \
 package '~a' has no source~%")
-                                   (location->string (package-location p))
+                                    (location->string (package-location p))
-                                   (package-name p))
+                                    (package-name p))
-                           '())
+                            '())
-                          (s
+                           (s
-                           (list (package-source-derivation store s)))))
+                            (list (package-source-derivation store s)))))
-                       (proc
+                        (proc
-                        (map (cut package-source-derivation store <>)
+                         (map (cut package-source-derivation store <>)
-                             (proc p))))))
+                              (proc p))))))
-                  ((? derivation? drv)
+                   ((? derivation? drv)
-                   (list drv))
+                    (list drv))
-                  ((? procedure? proc)
+                   ((? procedure? proc)
-                   (list (run-with-store store
+                    (list (run-with-store store
-                           (mbegin %store-monad
+                            (mbegin %store-monad
-                             (set-guile-for-build (default-guile))
+                              (set-guile-for-build (default-guile))
-                             (proc))
+                              (proc))
-                           #:system system)))
+                            #:system system)))
-                  ((? gexp? gexp)
+                   ((? gexp? gexp)
-                   (list (run-with-store store
+                    (list (run-with-store store
-                           (mbegin %store-monad
+                            (mbegin %store-monad
-                             (set-guile-for-build (default-guile))
+                              (set-guile-for-build (default-guile))
-                             (gexp->derivation "gexp" gexp
+                              (gexp->derivation "gexp" gexp
-                                               #:system system))))))
+                                                #:system system))))))
-                (map (cut transform store <>)
+                 (map (cut transform store <>)
-                     (options->things-to-build opts)))))
+                      (options->things-to-build opts))))))
 
 (define (show-build-log store file urls)
   "Show the build log for FILE, falling back to remote logs from URLS if

guix/ui.scm

@@ -76,6 +76,7 @@ (define-module (guix ui)
             show-manifest-transaction
             call-with-error-handling
             with-error-handling
+            with-unbound-variable-handling
             leave-on-EPIPE
             read/eval
             read/eval-package-expression
@@ -158,7 +159,7 @@ (define (print-unbound-variable-error port key args default-printer)
     ((proc message (variable) _ ...)
      ;; We can always omit PROC because when it's useful (i.e., different from
      ;; "module-lookup"), it gets displayed before.
-     (format port (G_ "~a: unbound variable") variable))
+     (format port (G_ "error: ~a: unbound variable") variable))
     (_
      (default-printer))))
 
@@ -309,6 +310,21 @@ (define* (display-hint message #:optional (port (current-error-port)))
                                            (- (terminal-columns) 5))))
             (texi->plain-text message))))
 
+(define* (report-unbound-variable-error args #:key frame)
+  "Return the given unbound-variable error, where ARGS is the list of 'throw'
+arguments."
+  (match args
+    ((key . args)
+     (print-exception (current-error-port) frame key args)))
+  (match args
+    (('unbound-variable proc message (variable) _ ...)
+     (match (known-variable-definition variable)
+       (#f
+        (display-hint (G_ "Did you forget a @code{use-modules} form?")))
+       ((? module? module)
+        (display-hint (format #f (G_ "Did you forget @code{(use-modules ~a)}?")
+                              (module-name module))))))))
+
 (define* (report-load-error file args #:optional frame)
   "Report the failure to load FILE, a user-provided Scheme file.
 ARGS is the list of arguments received by the 'throw' handler."
@@ -329,16 +345,8 @@ (define* (report-load-error file args #:optional frame)
      (let ((loc (source-properties->location properties)))
        (format (current-error-port) (G_ "~a: error: ~a~%")
                (location->string loc) message)))
-    (('unbound-variable proc message (variable) _ ...)
+    (('unbound-variable _ ...)
-     (match args
+     (report-unbound-variable-error args #:frame frame))
-       ((key . args)
-        (print-exception (current-error-port) frame key args)))
-     (match (known-variable-definition variable)
-       (#f
-        (display-hint (G_ "Did you forget a @code{use-modules} form?")))
-       (module
-        (display-hint (format #f (G_ "Did you forget @code{(use-modules ~a)}?")
-                              (module-name module))))))
     (('srfi-34 obj)
      (if (message-condition? obj)
          (if (error-location? obj)
@@ -379,6 +387,27 @@ (define (warn-about-load-error file args)         ;FIXME: factorize with ↑
      (warning (G_ "failed to load '~a':~%") file)
      (apply display-error #f (current-error-port) args))))
 
+(define (call-with-unbound-variable-handling thunk)
+  (define tag
+    (make-prompt-tag "user-code"))
+
+  (catch 'unbound-variable
+    (lambda ()
+      (call-with-prompt tag
+        thunk
+        (const #f)))
+    (const #t)
+    (rec (handle-error . args)
+         (let* ((stack (make-stack #t handle-error tag))
+                (frame (and stack (last-frame-with-source stack))))
+           (report-unbound-variable-error args #:frame frame)
+           (exit 1)))))
+
+(define-syntax-rule (with-unbound-variable-handling exp ...)
+  "Capture 'unbound-variable' exceptions in the dynamic extent of EXP... and
+report them in a user-friendly way."
+  (call-with-unbound-variable-handling (lambda () exp ...)))
+
 (define (install-locale)
   "Install the current locale settings."
   (catch 'system-error

tests/guix-build.sh

@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of GNU Guix.
 #
@@ -138,6 +138,25 @@ test `guix build -d --sources=transitive foo \
       | grep -e 'foo\.tar\.gz' -e 'bar\.tar\.gz' -e 'bar\.dat' \
       | wc -l` -eq 3
 
+
+# Unbound variables.
+cat > "$module_dir/foo.scm"<<EOF
+(define-module (foo)
+  #:use-module (guix tests)
+  #:use-module (guix build-system trivial))
+
+(define-public foo
+  (dummy-package "package-with-something-wrong"
+    (build-system trivial-build-system)
+    (inputs (quasiquote (("sed" ,sed))))))  ;unbound variable
+EOF
+
+if guix build package-with-something-wrong -n; then false; else true; fi
+guix build package-with-something-wrong -n 2> "$module_dir/err" || true
+grep "unbound" "$module_dir/err"		     # actual error
+grep "forget.*(gnu packages base)" "$module_dir/err" # hint
+rm -f "$module_dir"/*
+
 # Should all return valid log files.
 drv="`guix build -d -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"
 out="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"