From db030303b820297da23f8ce7101be88427eeef8d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 25 May 2015 22:52:41 +0200 Subject: guix system: Add '--on-error'. * guix/ui.scm (load*): Add #:on-error parameter. [tag, error-string]: New variables. Wrap 'load' call in 'call-with-prompt'. Pass TAG to 'make-stack'. Honor ON-ERROR after 'report-load-error' call. (report-load-error): Change to not exit on error. Make private. * guix/scripts/system.scm (show-help, %options): Add --on-error. (guix-system): Use 'load*' and pass it #:on-error. --- doc/guix.texi | 19 +++++++++++++++++ guix/scripts/system.scm | 10 ++++++++- guix/ui.scm | 55 +++++++++++++++++++++++++++++++++++-------------- 3 files changed, 68 insertions(+), 16 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index a4aa1b67fa..a97436cc0c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5995,6 +5995,25 @@ For the @code{vm-image} and @code{disk-image} actions, create an image of the given @var{size}. @var{size} may be a number of bytes, or it may include a unit as a suffix (@pxref{Block size, size specifications,, coreutils, GNU Coreutils}). + +@item --on-error=@var{strategy} +Apply @var{strategy} when an error occurs when reading @var{file}. +@var{strategy} may be one of the following: + +@table @code +@item nothing-special +Report the error concisely and exit. This is the default strategy. + +@item backtrace +Likewise, but also display a backtrace. + +@item debug +Report the error and enter Guile's debugger. From there, you can run +commands such as @code{,bt} to get a backtrace, @code{,locals} to +display local variable values, and more generally inspect the program's +state. @xref{Debug Commands,,, guile, GNU Guile Reference Manual}, for +a list of available debugging commands. +@end table @end table Note that all the actions above, except @code{build} and @code{init}, diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 277f31f6f4..b6d7d0d045 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -382,6 +382,9 @@ Build the operating system declared in FILE according to ACTION.\n")) - 'init', initialize a root file system to run GNU.\n")) (show-build-options-help) + (display (_ " + --on-error=STRATEGY + apply STRATEGY when an error occurs while reading FILE")) (display (_ " --image-size=SIZE for 'vm-image', produce an image of SIZE")) (display (_ " @@ -422,6 +425,10 @@ Build the operating system declared in FILE according to ACTION.\n")) (option '(#\V "version") #f #f (lambda args (show-version-and-exit "guix system"))) + (option '("on-error") #t #f + (lambda (opt name arg result) + (alist-cons 'on-error (string->symbol arg) + result))) (option '("image-size") #t #f (lambda (opt name arg result) (alist-cons 'image-size (size->number arg) @@ -514,7 +521,8 @@ Build the operating system declared in FILE according to ACTION.\n")) (action (assoc-ref opts 'action)) (system (assoc-ref opts 'system)) (os (if file - (read-operating-system file) + (load* file %user-module + #:on-error (assoc-ref opts 'on-error)) (leave (_ "no configuration file specified~%")))) (dry? (assoc-ref opts 'dry-run?)) diff --git a/guix/ui.scm b/guix/ui.scm index d590eef040..7490de080c 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -43,6 +43,8 @@ #:use-module (ice-9 match) #:use-module (ice-9 format) #:use-module (ice-9 regex) + #:autoload (system repl repl) (start-repl) + #:autoload (system repl debug) (make-debug stack->vector) #:replace (symlink) #:export (_ N_ @@ -51,7 +53,6 @@ leave make-user-module load* - report-load-error warn-about-load-error show-version-and-exit show-bug-report-information @@ -146,7 +147,8 @@ messages." modules) module)) -(define (load* file user-module) +(define* (load* file user-module + #:key (on-error 'nothing-special)) "Load the user provided Scheme source code FILE." (define (frame-with-source frame) ;; Walk from FRAME upwards until source location information is found. @@ -158,6 +160,14 @@ messages." frame (loop (frame-previous frame) frame))))) + (define (error-string frame args) + (call-with-output-string + (lambda (port) + (apply display-error frame port (cdr args))))) + + (define tag + (make-prompt-tag "user-code")) + (catch #t (lambda () ;; XXX: Force a recompilation to avoid ABI issues. @@ -170,11 +180,14 @@ messages." ;; 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)))))) + (call-with-prompt tag + (lambda () + ;; 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))) + (const #f)))))) (lambda _ ;; XXX: Errors are reported from the pre-unwind handler below, but ;; calling 'exit' from there has no effect, so we call it here. @@ -182,31 +195,43 @@ messages." (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)) + (let* ((stack (make-stack #t handle-error tag)) (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))))) + + (report-load-error file args frame) + + (case on-error + ((debug) + (newline) + (display (_ "entering debugger; type ',bt' for a backtrace\n")) + (start-repl #:debug (make-debug (stack->vector stack) 0 + (error-string frame args) + #f))) + ((backtrace) + (newline (current-error-port)) + (display-backtrace stack (current-error-port))) + (else + #t)))))) (define* (report-load-error file args #:optional frame) - "Report the failure to load FILE, a user-provided Scheme file, and exit. + "Report the failure to load FILE, a user-provided Scheme file. ARGS is the list of arguments received by the 'throw' handler." (match args (('system-error . _) (let ((err (system-error-errno args))) - (leave (_ "failed to load '~a': ~a~%") file (strerror err)))) + (report-error (_ "failed to load '~a': ~a~%") file (strerror err)))) (('syntax-error proc message properties form . rest) (let ((loc (source-properties->location properties))) (format (current-error-port) (_ "~a: error: ~a~%") - (location->string loc) message) - (exit 1))) + (location->string loc) message))) ((error args ...) (report-error (_ "failed to load '~a':~%") file) - (apply display-error frame (current-error-port) args) - (exit 1)))) + (apply display-error frame (current-error-port) args)))) (define (warn-about-load-error file args) ;FIXME: factorize with ↑ "Report the failure to load FILE, a user-provided Scheme file, without -- cgit v1.2.3