* [bug#40077] [PATCH 0/4] Inferior provide stack traces along with exceptions @ 2020-03-15 17:00 Ludovic Courtès 2020-03-15 17:15 ` [bug#40077] [PATCH 1/4] repl: Allow clients to send their protocol version Ludovic Courtès 2020-03-19 14:15 ` bug#40077: [PATCH 0/4] Inferior provide stack traces along with exceptions Ludovic Courtès 0 siblings, 2 replies; 6+ messages in thread From: Ludovic Courtès @ 2020-03-15 17:00 UTC (permalink / raw) To: 40077; +Cc: Ludovic Courtès Hello! This patch series allows inferiors to provide stack traces when an exception is thrown. The wire format needed to be changed to provide that info, and thus the protocol had to be adjusted to support both forward and backward compatibility: a new client must be able to talk to an old ‘guix repl’, and an old client must be able to talk to a new ‘guix repl’. To that end, clients now send the protocol version they support. Note that, with these patches, stack traces are available but inferior exceptions are not reported more nicely than before: --8<---------------cut here---------------start------------->8--- scheme@(guile-user)> (open-inferior "/home/ludo/src/guix" #:command "scripts/guix") $1 = #<<inferior> pid: pipe socket: #<input-output: file 7f08f4404a80> close: #<procedure close-pipe (p)> version: (0 1 1) packages: #<promise #<procedure 7f08f6813040 at guix/inferior.scm:161:32 ()>> table: #<promise #<procedure 7f08f43c6240 at guix/inferior.scm:162:32 ()>>> scheme@(guile-user)> (inferior-eval '(throw 'x 'y 'z) $1) ice-9/boot-9.scm:1669:16: In procedure raise-exception: ERROR: 1. &inferior-exception: arguments: (x y z) inferior: #<<inferior> pid: pipe socket: #<input-output: string 7f08f4404a80> close: #<procedure close-pipe (p)> version: (0 1 1) packages: #<promise #<procedure 7f08f6813040 at guix/inferior.scm:161:32 ()>> table: #<promise #<procedure 7f08f43c6240 at guix/inferior.scm:162:32 ()>>> stack: ((#f ("ice-9/boot-9.scm" 1763 13)) (raise-exception ("ice-9/boot-9.scm" 1668 16)) (#f (#f #f #f)) (#f ("guix/repl.scm" 92 21)) (with-exception-handler ("ice-9/boot-9.scm" 1735 10)) (with-exception-handler ("ice-9/boot-9.scm" 1730 15)) (#f ("guix/repl.scm" 119 7))) Entering a new prompt. Type `,bt' for a backtrace or `,q' to continue. --8<---------------cut here---------------end--------------->8--- This is left as an exercise to the reader. Feedback welcome! Ludo’. Ludovic Courtès (4): repl: Allow clients to send their protocol version. inferior: Adjust to protocol (0 1). repl: Return stack traces along with exceptions. inferior: '&inferior-exception' includes a stack trace. guix/inferior.scm | 24 +++++++++++-- guix/repl.scm | 86 ++++++++++++++++++++++++++++++++++++++-------- tests/inferior.scm | 3 ++ 3 files changed, 97 insertions(+), 16 deletions(-) -- 2.25.1 ^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#40077] [PATCH 1/4] repl: Allow clients to send their protocol version. 2020-03-15 17:00 [bug#40077] [PATCH 0/4] Inferior provide stack traces along with exceptions Ludovic Courtès @ 2020-03-15 17:15 ` Ludovic Courtès 2020-03-15 17:15 ` [bug#40077] [PATCH 2/4] inferior: Adjust to protocol (0 1) Ludovic Courtès ` (2 more replies) 2020-03-19 14:15 ` bug#40077: [PATCH 0/4] Inferior provide stack traces along with exceptions Ludovic Courtès 1 sibling, 3 replies; 6+ messages in thread From: Ludovic Courtès @ 2020-03-15 17:15 UTC (permalink / raw) To: 40077; +Cc: Ludovic Courtès * guix/repl.scm (send-repl-response): Add #:version. (machine-repl): Make 'loop' an internal define with a 'version' parameter. Pass VERSION to 'send-repl-response'. Send (0 1) as the protocol version. If the first element read from INPUT matches (() repl-version _ ...), interpret it as the client's protocol version. --- guix/repl.scm | 36 +++++++++++++++++++++++++----------- 1 file changed, 25 insertions(+), 11 deletions(-) diff --git a/guix/repl.scm b/guix/repl.scm index 0f75f9cd0b..a141003812 100644 --- a/guix/repl.scm +++ b/guix/repl.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -39,9 +39,10 @@ (one-of symbol? string? keyword? pair? null? array? number? boolean? char?))) -(define (send-repl-response exp output) +(define* (send-repl-response exp output + #:key (version '(0 0))) "Write the response corresponding to the evaluation of EXP to PORT, an -output port." +output port. VERSION is the client's protocol version we are targeting." (define (value->sexp value) (if (self-quoting? value) `(value ,value) @@ -72,13 +73,26 @@ The protocol of this REPL is meant to be machine-readable and provides proper support to represent multiple-value returns, exceptions, objects that lack a read syntax, and so on. As such it is more convenient and robust than parsing Guile's REPL prompt." - (write `(repl-version 0 0) output) - (newline output) - (force-output output) - - (let loop () - (match (read input) + (define (loop exp version) + (match exp ((? eof-object?) #t) (exp - (send-repl-response exp output) - (loop))))) + (send-repl-response exp output + #:version version) + (loop (read input) version)))) + + (write `(repl-version 0 1) output) + (newline output) + (force-output output) + + ;; In protocol version (0 0), clients would not send their supported + ;; protocol version. Thus, the code below checks for two case: (1) a (0 0) + ;; client that directly sends an expression to evaluate, and (2) a more + ;; recent client that sends (() repl-version ...). This form is chosen to + ;; be unambiguously distinguishable from a regular Scheme expression. + + (match (read input) + ((() 'repl-version version ...) + (loop (read input) version)) + (exp + (loop exp '(0 0))))) -- 2.25.1 ^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#40077] [PATCH 2/4] inferior: Adjust to protocol (0 1). 2020-03-15 17:15 ` [bug#40077] [PATCH 1/4] repl: Allow clients to send their protocol version Ludovic Courtès @ 2020-03-15 17:15 ` Ludovic Courtès 2020-03-15 17:15 ` [bug#40077] [PATCH 3/4] repl: Return stack traces along with exceptions Ludovic Courtès 2020-03-15 17:15 ` [bug#40077] [PATCH 4/4] inferior: '&inferior-exception' includes a stack trace Ludovic Courtès 2 siblings, 0 replies; 6+ messages in thread From: Ludovic Courtès @ 2020-03-15 17:15 UTC (permalink / raw) To: 40077; +Cc: Ludovic Courtès * guix/inferior.scm (port->inferior): For protocol (0 x ...), where x >= 1, send the (() repl-version ...) form. --- guix/inferior.scm | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/guix/inferior.scm b/guix/inferior.scm index 6b685ece30..ec8ff8ddbe 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -159,6 +159,15 @@ inferior." (letrec ((result (inferior 'pipe pipe close (cons 0 rest) (delay (%inferior-packages result)) (delay (%inferior-package-table result))))) + + ;; For protocol (0 1) and later, send the protocol version we support. + (match rest + ((n _ ...) + (when (>= n 1) + (send-inferior-request '(() repl-version 0 1) result))) + (_ + #t)) + (inferior-eval '(use-modules (guix)) result) (inferior-eval '(use-modules (gnu)) result) (inferior-eval '(use-modules (ice-9 match)) result) -- 2.25.1 ^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#40077] [PATCH 3/4] repl: Return stack traces along with exceptions. 2020-03-15 17:15 ` [bug#40077] [PATCH 1/4] repl: Allow clients to send their protocol version Ludovic Courtès 2020-03-15 17:15 ` [bug#40077] [PATCH 2/4] inferior: Adjust to protocol (0 1) Ludovic Courtès @ 2020-03-15 17:15 ` Ludovic Courtès 2020-03-15 17:15 ` [bug#40077] [PATCH 4/4] inferior: '&inferior-exception' includes a stack trace Ludovic Courtès 2 siblings, 0 replies; 6+ messages in thread From: Ludovic Courtès @ 2020-03-15 17:15 UTC (permalink / raw) To: 40077; +Cc: Ludovic Courtès * guix/repl.scm (repl-prompt): New variable. (stack->frames): New procedure. (send-repl-response)[frame->sexp, handle-exception]: New procedure. Pass HANDLE-EXCEPTION as a pre-unwind handler. (machine-repl): Define 'tag'. Bump protocol version to (0 1 1). Wrap 'loop' call in 'call-with-prompt'. --- guix/repl.scm | 64 +++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 54 insertions(+), 10 deletions(-) diff --git a/guix/repl.scm b/guix/repl.scm index a141003812..0ace5976cf 100644 --- a/guix/repl.scm +++ b/guix/repl.scm @@ -17,6 +17,8 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix repl) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:export (send-repl-response machine-repl)) @@ -39,6 +41,17 @@ (one-of symbol? string? keyword? pair? null? array? number? boolean? char?))) +(define repl-prompt + ;; Current REPL prompt or #f. + (make-parameter #f)) + +(define (stack->frames stack) + "Return STACK's frames as a list." + (unfold (cute >= <> (stack-length stack)) + (cut stack-ref stack <>) + 1+ + 0)) + (define* (send-repl-response exp output #:key (version '(0 0))) "Write the response corresponding to the evaluation of EXP to PORT, an @@ -49,6 +62,32 @@ output port. VERSION is the client's protocol version we are targeting." `(non-self-quoting ,(object-address value) ,(object->string value)))) + (define (frame->sexp frame) + `(,(frame-procedure-name frame) + ,(match (frame-source frame) + ((_ (? string? file) (? integer? line) . (? integer? column)) + (list file line column)) + (_ + '(#f #f #f))))) + + (define (handle-exception key . args) + (define reply + (match version + ((0 1 (? positive?) _ ...) + ;; Protocol (0 1 1) and later. + (let ((stack (if (repl-prompt) + (make-stack #t handle-exception (repl-prompt)) + (make-stack #t)))) + `(exception (arguments ,key ,@(map value->sexp args)) + (stack ,@(map frame->sexp (stack->frames stack)))))) + (_ + ;; Protocol (0 0). + `(exception ,key ,@(map value->sexp args))))) + + (write reply output) + (newline output) + (force-output output)) + (catch #t (lambda () (let ((results (call-with-values @@ -59,10 +98,8 @@ output port. VERSION is the client's protocol version we are targeting." output) (newline output) (force-output output))) - (lambda (key . args) - (write `(exception ,key ,@(map value->sexp args))) - (newline output) - (force-output output)))) + (const #t) + handle-exception)) (define* (machine-repl #:optional (input (current-input-port)) @@ -73,6 +110,9 @@ The protocol of this REPL is meant to be machine-readable and provides proper support to represent multiple-value returns, exceptions, objects that lack a read syntax, and so on. As such it is more convenient and robust than parsing Guile's REPL prompt." + (define tag + (make-prompt-tag "repl-prompt")) + (define (loop exp version) (match exp ((? eof-object?) #t) @@ -81,7 +121,7 @@ Guile's REPL prompt." #:version version) (loop (read input) version)))) - (write `(repl-version 0 1) output) + (write `(repl-version 0 1 1) output) (newline output) (force-output output) @@ -91,8 +131,12 @@ Guile's REPL prompt." ;; recent client that sends (() repl-version ...). This form is chosen to ;; be unambiguously distinguishable from a regular Scheme expression. - (match (read input) - ((() 'repl-version version ...) - (loop (read input) version)) - (exp - (loop exp '(0 0))))) + (call-with-prompt tag + (lambda () + (parameterize ((repl-prompt tag)) + (match (read input) + ((() 'repl-version version ...) + (loop (read input) version)) + (exp + (loop exp '(0 0)))))) + (const #f))) -- 2.25.1 ^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#40077] [PATCH 4/4] inferior: '&inferior-exception' includes a stack trace. 2020-03-15 17:15 ` [bug#40077] [PATCH 1/4] repl: Allow clients to send their protocol version Ludovic Courtès 2020-03-15 17:15 ` [bug#40077] [PATCH 2/4] inferior: Adjust to protocol (0 1) Ludovic Courtès 2020-03-15 17:15 ` [bug#40077] [PATCH 3/4] repl: Return stack traces along with exceptions Ludovic Courtès @ 2020-03-15 17:15 ` Ludovic Courtès 2 siblings, 0 replies; 6+ messages in thread From: Ludovic Courtès @ 2020-03-15 17:15 UTC (permalink / raw) To: 40077; +Cc: Ludovic Courtès * guix/inferior.scm (port->inferior): Bump protocol to (0 1 1). (&inferior-exception)[stack]: New field. (read-repl-response): Recognize 'exception' form for protocol (0 1 1). * tests/inferior.scm ("&inferior-exception"): Check the value returned by 'inferior-exception-stack'. --- guix/inferior.scm | 17 ++++++++++++++--- tests/inferior.scm | 3 +++ 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/guix/inferior.scm b/guix/inferior.scm index ec8ff8ddbe..c9a5ee5129 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -66,6 +66,7 @@ inferior-exception? inferior-exception-arguments inferior-exception-inferior + inferior-exception-stack read-repl-response inferior-packages @@ -164,7 +165,7 @@ inferior." (match rest ((n _ ...) (when (>= n 1) - (send-inferior-request '(() repl-version 0 1) result))) + (send-inferior-request '(() repl-version 0 1 1) result))) (_ #t)) @@ -211,7 +212,8 @@ equivalent. Return #f if the inferior could not be launched." (define-condition-type &inferior-exception &error inferior-exception? (arguments inferior-exception-arguments) ;key + arguments - (inferior inferior-exception-inferior)) ;<inferior> | #f + (inferior inferior-exception-inferior) ;<inferior> | #f + (stack inferior-exception-stack)) ;list of (FILE COLUMN LINE) (define* (read-repl-response port #:optional inferior) "Read a (guix repl) response from PORT and return it as a Scheme object. @@ -226,10 +228,19 @@ Raise '&inferior-exception' when an exception is read from PORT." (match (read port) (('values objects ...) (apply values (map sexp->object objects))) + (('exception ('arguments key objects ...) + ('stack frames ...)) + ;; Protocol (0 1 1) and later. + (raise (condition (&inferior-exception + (arguments (cons key (map sexp->object objects))) + (inferior inferior) + (stack frames))))) (('exception key objects ...) + ;; Protocol (0 0). (raise (condition (&inferior-exception (arguments (cons key (map sexp->object objects))) - (inferior inferior))))))) + (inferior inferior) + (stack '()))))))) (define (read-inferior-response inferior) (read-repl-response (inferior-socket inferior) diff --git a/tests/inferior.scm b/tests/inferior.scm index b4417d8629..2f5215920b 100644 --- a/tests/inferior.scm +++ b/tests/inferior.scm @@ -68,6 +68,9 @@ (guard (c ((inferior-exception? c) (close-inferior inferior) (and (eq? inferior (inferior-exception-inferior c)) + (match (inferior-exception-stack c) + (((_ (files lines columns)) ..1) + (member "guix/repl.scm" files))) (inferior-exception-arguments c)))) (inferior-eval '(throw 'a 'b 'c 'd) inferior) 'badness))) -- 2.25.1 ^ permalink raw reply related [flat|nested] 6+ messages in thread
* bug#40077: [PATCH 0/4] Inferior provide stack traces along with exceptions 2020-03-15 17:00 [bug#40077] [PATCH 0/4] Inferior provide stack traces along with exceptions Ludovic Courtès 2020-03-15 17:15 ` [bug#40077] [PATCH 1/4] repl: Allow clients to send their protocol version Ludovic Courtès @ 2020-03-19 14:15 ` Ludovic Courtès 1 sibling, 0 replies; 6+ messages in thread From: Ludovic Courtès @ 2020-03-19 14:15 UTC (permalink / raw) To: 40077-done Ludovic Courtès <ludo@gnu.org> skribis: > repl: Allow clients to send their protocol version. > inferior: Adjust to protocol (0 1). > repl: Return stack traces along with exceptions. > inferior: '&inferior-exception' includes a stack trace. Pushed as 1dca6aaafa9f842565deab1fe7e6929f25544551. Ludo’. ^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2020-03-19 14:16 UTC | newest] Thread overview: 6+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2020-03-15 17:00 [bug#40077] [PATCH 0/4] Inferior provide stack traces along with exceptions Ludovic Courtès 2020-03-15 17:15 ` [bug#40077] [PATCH 1/4] repl: Allow clients to send their protocol version Ludovic Courtès 2020-03-15 17:15 ` [bug#40077] [PATCH 2/4] inferior: Adjust to protocol (0 1) Ludovic Courtès 2020-03-15 17:15 ` [bug#40077] [PATCH 3/4] repl: Return stack traces along with exceptions Ludovic Courtès 2020-03-15 17:15 ` [bug#40077] [PATCH 4/4] inferior: '&inferior-exception' includes a stack trace Ludovic Courtès 2020-03-19 14:15 ` bug#40077: [PATCH 0/4] Inferior provide stack traces along with exceptions Ludovic Courtès
Code repositories for project(s) associated with this external index https://git.savannah.gnu.org/cgit/guix.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.