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.
This commit is contained in:
Ludovic Courtès 2018-05-04 15:05:05 +02:00
parent 7f2f6a2cb2
commit 2d2f98efb3
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 100 additions and 48 deletions

View File

@ -661,43 +661,47 @@ build."
(define system (assoc-ref opts 'system)) (define system (assoc-ref opts 'system))
(define graft? (assoc-ref opts 'graft?)) (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~%") 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) (define (show-build-log store file urls)
"Show the build log for FILE, falling back to remote logs from URLS if "Show the build log for FILE, falling back to remote logs from URLS if

View File

@ -76,6 +76,7 @@
show-manifest-transaction show-manifest-transaction
call-with-error-handling call-with-error-handling
with-error-handling with-error-handling
with-unbound-variable-handling
leave-on-EPIPE leave-on-EPIPE
read/eval read/eval
read/eval-package-expression read/eval-package-expression
@ -158,7 +159,7 @@ messages."
((proc message (variable) _ ...) ((proc message (variable) _ ...)
;; We can always omit PROC because when it's useful (i.e., different from ;; We can always omit PROC because when it's useful (i.e., different from
;; "module-lookup"), it gets displayed before. ;; "module-lookup"), it gets displayed before.
(format port (G_ "~a: unbound variable") variable)) (format port (G_ "error: ~a: unbound variable") variable))
(_ (_
(default-printer)))) (default-printer))))
@ -309,6 +310,21 @@ PORT."
(- (terminal-columns) 5)))) (- (terminal-columns) 5))))
(texi->plain-text message)))) (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) (define* (report-load-error file args #:optional frame)
"Report the failure to load FILE, a user-provided Scheme file. "Report the failure to load FILE, a user-provided Scheme file.
ARGS is the list of arguments received by the 'throw' handler." ARGS is the list of arguments received by the 'throw' handler."
@ -329,16 +345,8 @@ ARGS is the list of arguments received by the 'throw' handler."
(let ((loc (source-properties->location properties))) (let ((loc (source-properties->location properties)))
(format (current-error-port) (G_ "~a: error: ~a~%") (format (current-error-port) (G_ "~a: error: ~a~%")
(location->string loc) message))) (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) (('srfi-34 obj)
(if (message-condition? obj) (if (message-condition? obj)
(if (error-location? obj) (if (error-location? obj)
@ -379,6 +387,27 @@ exiting. ARGS is the list of arguments received by the 'throw' handler."
(warning (G_ "failed to load '~a':~%") file) (warning (G_ "failed to load '~a':~%") file)
(apply display-error #f (current-error-port) args)))) (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) (define (install-locale)
"Install the current locale settings." "Install the current locale settings."
(catch 'system-error (catch 'system-error

View File

@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU # 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. # 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' \ | grep -e 'foo\.tar\.gz' -e 'bar\.tar\.gz' -e 'bar\.dat' \
| wc -l` -eq 3 | 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. # Should all return valid log files.
drv="`guix build -d -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`" drv="`guix build -d -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"
out="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`" out="`guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'`"