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:
parent
7f2f6a2cb2
commit
2d2f98efb3
|
@ -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
|
||||||
|
|
51
guix/ui.scm
51
guix/ui.scm
|
@ -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
|
||||||
|
|
|
@ -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)'`"
|
||||||
|
|
Loading…
Reference in New Issue