mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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
parent
7f2f6a2cb2
commit
2d2f98efb3
3 changed files with 100 additions and 48 deletions
|
|
@ -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?))
|
||||
(append-map (match-lambda
|
||||
((? package? p)
|
||||
(let ((p (or (and graft? (package-replacement p)) p)))
|
||||
(match src
|
||||
(#f
|
||||
(list (package->derivation store p system)))
|
||||
(#t
|
||||
(match (package-source p)
|
||||
(#f
|
||||
(format (current-error-port)
|
||||
(G_ "~a: warning: \
|
||||
;; We may get 'unbound-variable' errors while evaluating the 'inputs' fields
|
||||
;; of user packages. Since 'guix build' is the primary tool for people
|
||||
;; testing new packages, report such errors gracefully.
|
||||
(with-unbound-variable-handling
|
||||
(parameterize ((%graft? graft?))
|
||||
(append-map (match-lambda
|
||||
((? package? p)
|
||||
(let ((p (or (and graft? (package-replacement p)) p)))
|
||||
(match src
|
||||
(#f
|
||||
(list (package->derivation store p system)))
|
||||
(#t
|
||||
(match (package-source p)
|
||||
(#f
|
||||
(format (current-error-port)
|
||||
(G_ "~a: warning: \
|
||||
package '~a' has no source~%")
|
||||
(location->string (package-location p))
|
||||
(package-name p))
|
||||
'())
|
||||
(s
|
||||
(list (package-source-derivation store s)))))
|
||||
(proc
|
||||
(map (cut package-source-derivation store <>)
|
||||
(proc p))))))
|
||||
((? derivation? drv)
|
||||
(list drv))
|
||||
((? procedure? proc)
|
||||
(list (run-with-store store
|
||||
(mbegin %store-monad
|
||||
(set-guile-for-build (default-guile))
|
||||
(proc))
|
||||
#:system system)))
|
||||
((? gexp? gexp)
|
||||
(list (run-with-store store
|
||||
(mbegin %store-monad
|
||||
(set-guile-for-build (default-guile))
|
||||
(gexp->derivation "gexp" gexp
|
||||
#:system system))))))
|
||||
(map (cut transform store <>)
|
||||
(options->things-to-build opts)))))
|
||||
(location->string (package-location p))
|
||||
(package-name p))
|
||||
'())
|
||||
(s
|
||||
(list (package-source-derivation store s)))))
|
||||
(proc
|
||||
(map (cut package-source-derivation store <>)
|
||||
(proc p))))))
|
||||
((? derivation? drv)
|
||||
(list drv))
|
||||
((? procedure? proc)
|
||||
(list (run-with-store store
|
||||
(mbegin %store-monad
|
||||
(set-guile-for-build (default-guile))
|
||||
(proc))
|
||||
#:system system)))
|
||||
((? gexp? gexp)
|
||||
(list (run-with-store store
|
||||
(mbegin %store-monad
|
||||
(set-guile-for-build (default-guile))
|
||||
(gexp->derivation "gexp" gexp
|
||||
#:system system))))))
|
||||
(map (cut transform store <>)
|
||||
(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
|
||||
|
|
|
|||
51
guix/ui.scm
51
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) _ ...)
|
||||
(match args
|
||||
((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))))))
|
||||
(('unbound-variable _ ...)
|
||||
(report-unbound-variable-error args #:frame frame))
|
||||
(('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
|
||||
|
|
|
|||
|
|
@ -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)'`"
|
||||
|
|
|
|||
Loading…
Reference in a new issue