mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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:
parent
fbb25e5651
commit
2abcc97fd1
3 changed files with 65 additions and 5 deletions
|
@ -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))
|
||||
|
|
43
guix/ui.scm
43
guix/ui.scm
|
@ -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 ↑
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue