diff options
author | Justus Winter <[email protected]> | 2016-09-19 16:45:44 +0000 |
---|---|---|
committer | Justus Winter <[email protected]> | 2016-09-19 16:49:17 +0000 |
commit | 884e78efe1f3ba50513bf81c8b4804d22b25eac4 (patch) | |
tree | 8118a981411d5f6a0ab428e98c3969cef8101397 | |
parent | tests: Implement interpreter shutdown using exceptions. (diff) | |
download | gnupg-884e78efe1f3ba50513bf81c8b4804d22b25eac4.tar.gz gnupg-884e78efe1f3ba50513bf81c8b4804d22b25eac4.zip |
tests: Refine the repl function.
* tests/gpgscm/repl.scm (repl): Add an argument 'environment'.
(interactive-repl): Add an optional argument 'environment'.
--
With this change, we can drop
(interactive-repl (current-environment))
anywhere into the code and do some interactive debugging.
Signed-off-by: Justus Winter <[email protected]>
-rw-r--r-- | tests/gpgscm/repl.scm | 42 |
1 files changed, 21 insertions, 21 deletions
diff --git a/tests/gpgscm/repl.scm b/tests/gpgscm/repl.scm index 896554faf..78b8151a0 100644 --- a/tests/gpgscm/repl.scm +++ b/tests/gpgscm/repl.scm @@ -20,25 +20,24 @@ ;; Interactive repl using 'prompt' function. P must be a function ;; that given the current entered prefix returns the prompt to ;; display. -(define (repl p) - (let ((repl-environment (make-environment))) - (call/cc - (lambda (exit) - (let loop ((prefix "")) - (let ((line (prompt (p prefix)))) - (if (and (not (eof-object? line)) (= 0 (string-length line))) - (exit (loop prefix))) - (if (not (eof-object? line)) - (let* ((next (string-append prefix line)) - (c (catch (begin (echo "Parse error:" *error*) - (loop prefix)) - (read (open-input-string next))))) - (if (not (eof-object? c)) - (begin - (catch (echo "Error:" *error*) - (echo " ===>" (eval c repl-environment))) - (exit (loop "")))) - (exit (loop next)))))))))) +(define (repl p environment) + (call/cc + (lambda (exit) + (let loop ((prefix "")) + (let ((line (prompt (p prefix)))) + (if (and (not (eof-object? line)) (= 0 (string-length line))) + (exit (loop prefix))) + (if (not (eof-object? line)) + (let* ((next (string-append prefix line)) + (c (catch (begin (echo "Parse error:" *error*) + (loop prefix)) + (read (open-input-string next))))) + (if (not (eof-object? c)) + (begin + (catch (echo "Error:" *error*) + (echo " ===>" (eval c environment))) + (exit (loop "")))) + (exit (loop next))))))))) (define (prompt-append-prefix prompt prefix) (string-append prompt (if (> (string-length prefix) 0) @@ -46,5 +45,6 @@ "> "))) ;; Default repl run by main.c. -(define (interactive-repl) - (repl (lambda (p) (prompt-append-prefix "gpgscm " p)))) +(define (interactive-repl . environment) + (repl (lambda (p) (prompt-append-prefix "gpgscm " p)) + (if (null? environment) (interaction-environment) (car environment)))) |