diff options
| -rw-r--r-- | NEWS | 8 | ||||
| -rw-r--r-- | modules/ssh/dist/node.scm | 53 | ||||
| -rw-r--r-- | tests/dist.scm | 9 |
3 files changed, 50 insertions, 20 deletions
@@ -33,6 +33,14 @@ Copyright (C) Artyom V. Poptsov <poptsov.artyom@gmail.com> Reported by Mathieu, in <https://github.com/artyom-poptsov/guile-ssh/issues/3> +***** 'rrepl-get-result' now handles unknown # objects + The procedure would always fail to read unknown objects (e.g. instances + of Guile-SSH session) properly, raising an obscure errors like + "Unknown # object: #\<". Now the procedure raises 'node-repl-error' + with full evaluation result gotten from RREPL. + + Reported by Mathieu, in + <https://github.com/artyom-poptsov/guile-ssh/issues/3> ** Changes in (ssh dist node) *** 'node-eval' now can work without procps The procedure now checks if procps package is present on a node and uses diff --git a/modules/ssh/dist/node.scm b/modules/ssh/dist/node.scm index 5174714..d657c29 100644 --- a/modules/ssh/dist/node.scm +++ b/modules/ssh/dist/node.scm @@ -193,9 +193,9 @@ In procedure module-lookup: Unbound variable: .*")) evaluation result, a number of the evaluation, a module name and a language name. Throw 'node-repl-error' on an error." - (define (raise-repl-error result) + (define (raise-repl-error result . rest) "Raise an REPL error with a RESULT of evaluation." - (node-repl-error "Evaluation failed" result)) + (node-repl-error "Evaluation failed" result rest)) (define (parse-result matches lines) (if (null? lines) @@ -210,25 +210,38 @@ name. Throw 'node-repl-error' on an error." (define (read-result match rest) (let* ((matches (parse-result (list match) rest)) (len (length matches))) - (if (= len 1) - (let ((m (car matches))) - (values (read-string (match:substring m 4)) - (string->number (match:substring m 3)))) - (let ((rv (make-vector len)) - (nv (make-vector len))) + (catch #t + (lambda () + (if (= len 1) + (let ((m (car matches))) + (values (read-string (match:substring m 4)) + (string->number (match:substring m 3)))) + (let ((rv (make-vector len)) + (nv (make-vector len))) + ;; The 1st match also contains a module name and language name, + ;; but we want only the evaluation result and the result number. + (let ((m (car matches))) + (vector-set! rv 0 (read-string (match:substring m 4))) + (vector-set! nv 0 (string->number (match:substring m 3)))) - ;; The 1st match also contains a module name and language name, - ;; but we want only the evaluation result and the result number. - (let ((m (car matches))) - (vector-set! rv 0 (read-string (match:substring m 4))) - (vector-set! nv 0 (string->number (match:substring m 3)))) - - (do ((i 1 (1+ i))) - ((= i len)) - (let ((m (list-ref matches i))) - (vector-set! rv i (read-string (match:substring m 2))) - (vector-set! nv i (string->number (match:substring m 1))))) - (values rv nv))))) + (do ((i 1 (1+ i))) + ((= i len)) + (let ((m (list-ref matches i))) + (vector-set! rv i (read-string (match:substring m 2))) + (vector-set! nv i (string->number (match:substring m 1))))) + (values rv nv)))) + (lambda (key . message) + (case key + ((read-error) + (raise-repl-error (format #f "Reader error: ~a: ~a: ~a" + (car message) + (apply format #f (cadr message) (cddr message)) + (string-join (map (lambda (match) (match:substring match 0)) + matches))))) + (else + (raise-repl-error message + (map (lambda (match) (match:substring match 0)) + matches)))))))) (define (error? line) "Does a LINE contain an REPL error message?" diff --git a/tests/dist.scm b/tests/dist.scm index 52206f4..786c854 100644 --- a/tests/dist.scm +++ b/tests/dist.scm @@ -146,6 +146,15 @@ Unbound variable: e" "socket:9:7: In procedure module-lookup: Unbound variable: e")) rrepl-get-result)) +(test-error-with-log/= "rrepl-get-result, unknown # object error" + 'node-repl-error "Reader error: scm_lreadr: #<unknown port>:1:3: \ +Unknown # object: (#\\<): scheme@(guile-user)> \ +$4 = #<session #<undefined>@#<undefined>:22 (disconnected) 453fff>" + (call-with-input-string + (string-append "scheme@(guile-user)> $4 = " + "#<session #<undefined>@#<undefined>:22 (disconnected) 453fff>") + rrepl-get-result)) + (test-assert "rrepl-get-result, elisp" (receive (result eval-num module-name lang) (call-with-input-string "elisp@(guile-user)> $0 = #nil" |