[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/02: guix system: Add '--on-error'.
|
From: |
Ludovic Courtès |
|
Subject: |
01/02: guix system: Add '--on-error'. |
|
Date: |
Mon, 25 May 2015 20:57:20 +0000 |
civodul pushed a commit to branch master
in repository guix.
commit db030303b820297da23f8ce7101be88427eeef8d
Author: Ludovic Courtès <address@hidden>
Date: Mon May 25 22:52:41 2015 +0200
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 a4aa1b6..a97436c 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}).
+
address@hidden address@hidden
+Apply @var{strategy} when an error occurs when reading @var{file}.
address@hidden may be one of the following:
+
address@hidden @code
address@hidden nothing-special
+Report the error concisely and exit. This is the default strategy.
+
address@hidden backtrace
+Likewise, but also display a backtrace.
+
address@hidden 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.
address@hidden 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 277f31f..b6d7d0d 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -383,6 +383,9 @@ Build the operating system declared in FILE according to
ACTION.\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 (_ "
--no-grub for 'init', do not install GRUB"))
@@ -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 d590eef..7490de0 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