me
/
guix
Archived
1
0
Fork 0

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.
master
Ludovic Courtès 2015-05-25 22:52:41 +02:00
parent 5f1087c481
commit db030303b8
3 changed files with 68 additions and 16 deletions

View File

@ -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 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,, include a unit as a suffix (@pxref{Block size, size specifications,,
coreutils, GNU Coreutils}). 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 @end table
Note that all the actions above, except @code{build} and @code{init}, Note that all the actions above, except @code{build} and @code{init},

View File

@ -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")) - 'init', initialize a root file system to run GNU.\n"))
(show-build-options-help) (show-build-options-help)
(display (_ "
--on-error=STRATEGY
apply STRATEGY when an error occurs while reading FILE"))
(display (_ " (display (_ "
--image-size=SIZE for 'vm-image', produce an image of SIZE")) --image-size=SIZE for 'vm-image', produce an image of SIZE"))
(display (_ " (display (_ "
@ -422,6 +425,10 @@ Build the operating system declared in FILE according to ACTION.\n"))
(option '(#\V "version") #f #f (option '(#\V "version") #f #f
(lambda args (lambda args
(show-version-and-exit "guix system"))) (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 (option '("image-size") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'image-size (size->number arg) (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)) (action (assoc-ref opts 'action))
(system (assoc-ref opts 'system)) (system (assoc-ref opts 'system))
(os (if file (os (if file
(read-operating-system file) (load* file %user-module
#:on-error (assoc-ref opts 'on-error))
(leave (_ "no configuration file specified~%")))) (leave (_ "no configuration file specified~%"))))
(dry? (assoc-ref opts 'dry-run?)) (dry? (assoc-ref opts 'dry-run?))

View File

@ -43,6 +43,8 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:autoload (system repl repl) (start-repl)
#:autoload (system repl debug) (make-debug stack->vector)
#:replace (symlink) #:replace (symlink)
#:export (_ #:export (_
N_ N_
@ -51,7 +53,6 @@
leave leave
make-user-module make-user-module
load* load*
report-load-error
warn-about-load-error warn-about-load-error
show-version-and-exit show-version-and-exit
show-bug-report-information show-bug-report-information
@ -146,7 +147,8 @@ messages."
modules) modules)
module)) module))
(define (load* file user-module) (define* (load* file user-module
#:key (on-error 'nothing-special))
"Load the user provided Scheme source code FILE." "Load the user provided Scheme source code FILE."
(define (frame-with-source frame) (define (frame-with-source frame)
;; Walk from FRAME upwards until source location information is found. ;; Walk from FRAME upwards until source location information is found.
@ -158,6 +160,14 @@ messages."
frame frame
(loop (frame-previous frame) 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 (catch #t
(lambda () (lambda ()
;; XXX: Force a recompilation to avoid ABI issues. ;; XXX: Force a recompilation to avoid ABI issues.
@ -170,11 +180,14 @@ messages."
;; Hide the "auto-compiling" messages. ;; Hide the "auto-compiling" messages.
(parameterize ((current-warning-port (%make-void-port "w"))) (parameterize ((current-warning-port (%make-void-port "w")))
(call-with-prompt tag
(lambda ()
;; Give 'load' an absolute file name so that it doesn't try to ;; Give 'load' an absolute file name so that it doesn't try to
;; search for FILE in %LOAD-PATH. Note: use 'load', not ;; search for FILE in %LOAD-PATH. Note: use 'load', not
;; 'primitive-load', so that FILE is compiled, which then allows us ;; 'primitive-load', so that FILE is compiled, which then allows us
;; to provide better error reporting with source line numbers. ;; to provide better error reporting with source line numbers.
(load (canonicalize-path file)))))) (load (canonicalize-path file)))
(const #f))))))
(lambda _ (lambda _
;; XXX: Errors are reported from the pre-unwind handler below, but ;; XXX: Errors are reported from the pre-unwind handler below, but
;; calling 'exit' from there has no effect, so we call it here. ;; calling 'exit' from there has no effect, so we call it here.
@ -182,31 +195,43 @@ messages."
(rec (handle-error . args) (rec (handle-error . args)
;; Capture the stack up to this procedure call, excluded, and pass ;; Capture the stack up to this procedure call, excluded, and pass
;; the faulty stack frame to 'report-load-error'. ;; 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)) (depth (stack-length stack))
(last (and (> depth 0) (stack-ref stack 0))) (last (and (> depth 0) (stack-ref stack 0)))
(frame (frame-with-source (frame (frame-with-source
(if (> depth 1) (if (> depth 1)
(stack-ref stack 1) ;skip the 'throw' frame (stack-ref stack 1) ;skip the 'throw' frame
last)))) 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) (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." ARGS is the list of arguments received by the 'throw' handler."
(match args (match args
(('system-error . _) (('system-error . _)
(let ((err (system-error-errno args))) (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) (('syntax-error proc message properties form . rest)
(let ((loc (source-properties->location properties))) (let ((loc (source-properties->location properties)))
(format (current-error-port) (_ "~a: error: ~a~%") (format (current-error-port) (_ "~a: error: ~a~%")
(location->string loc) message) (location->string loc) message)))
(exit 1)))
((error args ...) ((error args ...)
(report-error (_ "failed to load '~a':~%") file) (report-error (_ "failed to load '~a':~%") file)
(apply display-error frame (current-error-port) args) (apply display-error frame (current-error-port) args))))
(exit 1))))
(define (warn-about-load-error file args) ;FIXME: factorize with ↑ (define (warn-about-load-error file args) ;FIXME: factorize with ↑
"Report the failure to load FILE, a user-provided Scheme file, without "Report the failure to load FILE, a user-provided Scheme file, without