aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJustus Winter <[email protected]>2016-09-19 16:45:44 +0000
committerJustus Winter <[email protected]>2016-09-19 16:49:17 +0000
commit884e78efe1f3ba50513bf81c8b4804d22b25eac4 (patch)
tree8118a981411d5f6a0ab428e98c3969cef8101397
parenttests: Implement interpreter shutdown using exceptions. (diff)
downloadgnupg-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.scm42
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))))