ui: Auto-compile user code, and improve error reporting.

Reported by Christian Grothoff.

* guix/ui.scm (load*): Add 'frame-with-source'.  Set
  %load-should-auto-compile.  Change error handle to just (exit 1).  Add
  pre-unwind handler to capture the stack and call 'report-load-error'.
  (report-load-error): Add optional 'frame' parameter and pass it to
  'display-error'.
* tests/guix-system.sh: Add "unbound variable" test.
This commit is contained in:
Ludovic Courtès 2015-05-25 18:25:19 +02:00
parent fbb25e5651
commit 2abcc97fd1
3 changed files with 65 additions and 5 deletions

View file

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

View file

@ -35,6 +35,7 @@ (define-module (guix ui)
#: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 @@ (define (make-user-module modules)
(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 @@ (define (report-load-error file args)
(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 ↑

View file

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