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 ;; Interactive repl using 'prompt' function. P must be a function
;; that given the current entered prefix returns the prompt to ;; that given the current entered prefix returns the prompt to
;; display. ;; display.
(define (repl p) (define (repl p environment)
(let ((repl-environment (make-environment))) (call/cc
(call/cc (lambda (exit)
(lambda (exit) (let loop ((prefix ""))
(let loop ((prefix "")) (let ((line (prompt (p prefix))))
(let ((line (prompt (p prefix)))) (if (and (not (eof-object? line)) (= 0 (string-length line)))
(if (and (not (eof-object? line)) (= 0 (string-length line))) (exit (loop prefix)))
(exit (loop prefix))) (if (not (eof-object? line))
(if (not (eof-object? line)) (let* ((next (string-append prefix line))
(let* ((next (string-append prefix line)) (c (catch (begin (echo "Parse error:" *error*)
(c (catch (begin (echo "Parse error:" *error*) (loop prefix))
(loop prefix)) (read (open-input-string next)))))
(read (open-input-string next))))) (if (not (eof-object? c))
(if (not (eof-object? c)) (begin
(begin (catch (echo "Error:" *error*)
(catch (echo "Error:" *error*) (echo " ===>" (eval c environment)))
(echo " ===>" (eval c repl-environment))) (exit (loop ""))))
(exit (loop "")))) (exit (loop next)))))))))
(exit (loop next))))))))))
(define (prompt-append-prefix prompt prefix) (define (prompt-append-prefix prompt prefix)
(string-append prompt (if (> (string-length prefix) 0) (string-append prompt (if (> (string-length prefix) 0)
@ -46,5 +45,6 @@
"> "))) "> ")))
;; Default repl run by main.c. ;; Default repl run by main.c.
(define (interactive-repl) (define (interactive-repl . environment)
(repl (lambda (p) (prompt-append-prefix "gpgscm " p)))) (repl (lambda (p) (prompt-append-prefix "gpgscm " p))
(if (null? environment) (interaction-environment) (car environment))))