diff options
| -rw-r--r-- | .dir-locals.el | 1 | ||||
| -rw-r--r-- | guix/ui.scm | 43 | ||||
| -rw-r--r-- | tests/guix-system.sh | 26 |
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 |