summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.dir-locals.el1
-rw-r--r--guix/ui.scm43
-rw-r--r--tests/guix-system.sh26
3 files changed, 65 insertions, 5 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index eb3da94da4..7ac7e13ff1 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -13,6 +13,7 @@
.
((indent-tabs-mode . nil)
(eval . (put 'eval-when 'scheme-indent-function 1))
+ (eval . (put 'call-with-prompt 'scheme-indent-function 1))
(eval . (put 'test-assert 'scheme-indent-function 1))
(eval . (put 'test-assertm 'scheme-indent-function 1))
(eval . (put 'test-equal 'scheme-indent-function 1))
diff --git a/guix/ui.scm b/guix/ui.scm
index 2b62e7abc8..d590eef040 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -35,6 +35,7 @@
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-31)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
@@ -147,18 +148,50 @@ messages."
(define (load* file user-module)
"Load the user provided Scheme source code FILE."
+ (define (frame-with-source frame)
+ ;; Walk from FRAME upwards until source location information is found.
+ (let loop ((frame frame)
+ (previous frame))
+ (if (not frame)
+ previous
+ (if (frame-source frame)
+ frame
+ (loop (frame-previous frame) frame)))))
+
(catch #t
(lambda ()
+ ;; XXX: Force a recompilation to avoid ABI issues.
(set! %fresh-auto-compile #t)
+ (set! %load-should-auto-compile #t)
(save-module-excursion
(lambda ()
(set-current-module user-module)
- (primitive-load file))))
- (lambda args
- (report-load-error file args))))
-(define (report-load-error file args)
+ ;; Hide the "auto-compiling" messages.
+ (parameterize ((current-warning-port (%make-void-port "w")))
+ ;; Give 'load' an absolute file name so that it doesn't try to
+ ;; search for FILE in %LOAD-PATH. Note: use 'load', not
+ ;; 'primitive-load', so that FILE is compiled, which then allows us
+ ;; to provide better error reporting with source line numbers.
+ (load (canonicalize-path file))))))
+ (lambda _
+ ;; XXX: Errors are reported from the pre-unwind handler below, but
+ ;; calling 'exit' from there has no effect, so we call it here.
+ (exit 1))
+ (rec (handle-error . args)
+ ;; Capture the stack up to this procedure call, excluded, and pass
+ ;; the faulty stack frame to 'report-load-error'.
+ (let* ((stack (make-stack #t handle-error))
+ (depth (stack-length stack))
+ (last (and (> depth 0) (stack-ref stack 0)))
+ (frame (frame-with-source
+ (if (> depth 1)
+ (stack-ref stack 1) ;skip the 'throw' frame
+ last))))
+ (report-load-error file args frame)))))
+
+(define* (report-load-error file args #:optional frame)
"Report the failure to load FILE, a user-provided Scheme file, and exit.
ARGS is the list of arguments received by the 'throw' handler."
(match args
@@ -172,7 +205,7 @@ ARGS is the list of arguments received by the 'throw' handler."
(exit 1)))
((error args ...)
(report-error (_ "failed to load '~a':~%") file)
- (apply display-error #f (current-error-port) args)
+ (apply display-error frame (current-error-port) args)
(exit 1))))
(define (warn-about-load-error file args) ;FIXME: factorize with ↑
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 7008ef8031..4289db2390 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -45,6 +45,32 @@ else
fi
+# Reporting of unbound variables.
+
+cat > "$tmpfile" <<EOF
+(use-modules (gnu)) ; 1
+(use-service-modules networking) ; 2
+
+(operating-system ; 4
+ (host-name "antelope") ; 5
+ (timezone "Europe/Paris") ; 6
+ (locale "en_US.UTF-8") ; 7
+
+ (bootloader (GRUB-config (device "/dev/sdX"))) ; 9
+ (file-systems (cons (file-system
+ (device "root")
+ (title 'label)
+ (mount-point "/")
+ (type "ext4"))
+ %base-file-systems)))
+EOF
+
+if guix system build "$tmpfile" -n 2> "$errorfile"
+then false
+else
+ grep "$tmpfile:9:.*[Uu]nbound variable.*GRUB-config" "$errorfile"
+fi
+
# Reporting of duplicate service identifiers.
cat > "$tmpfile" <<EOF