security-and-privacy/gnupg
security-and-privacy
/
gnupg
mirror of git://git.gnupg.org/gnupg.git
1
0
Fork 0
Code Releases Activity

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 <justus@g10code.com>
This commit is contained in:
Justus Winter 2016-09-19 18:45:44 +02:00
parent 9a0659a65c
commit 884e78efe1
1 changed files with 21 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
tests/gpgscm/repl.scm
View File

@ -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))))