rekahsoft/guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

guix build: Nicely report unbound variables with hints.

Browse Source 
* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
guix/scripts/build.scm
View File

@ -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
View File

@ -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

21
tests/guix-build.sh
View File

@ -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)'`"