[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/05: guix build: Nicely report unbound variables with hints.
|
From: |
Ludovic Courtès |
|
Subject: |
02/05: guix build: Nicely report unbound variables with hints. |
|
Date: |
Fri, 4 May 2018 09:29:29 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 2d2f98efb36db3f003d950a004806234962b4f4d
Author: Ludovic Courtès <address@hidden>
Date: Fri May 4 15:05:05 2018 +0200
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 | 76 ++++++++++++++++++++++++++------------------------
guix/ui.scm | 51 +++++++++++++++++++++++++--------
tests/guix-build.sh | 21 +++++++++++++-
3 files changed, 100 insertions(+), 48 deletions(-)
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 401087e..4dd4fbc 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -661,43 +661,47 @@ build."
(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
diff --git a/guix/ui.scm b/guix/ui.scm
index 223d2eb..8d35160 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -76,6 +76,7 @@
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 @@ messages."
((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 @@ 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 @@ ARGS is the list of arguments received by the 'throw'
handler."
(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 @@ exiting. ARGS is the list of arguments received by the
'throw' handler."
(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
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index b84723f..92e7299 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <address@hidden>
+# Copyright © 2012, 2013, 2014, 2016, 2017, 2018 Ludovic Courtès
<address@hidden>
#
# 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)'`"