From b4d25082fd4502ec01d511c22fecd60d513b81f4 Mon Sep 17 00:00:00 2001 From: Justus Winter Date: Fri, 14 Jul 2017 12:57:41 +0200 Subject: gpgscm: Library improvements. * tests/gpgscm/repl.scm (prompt-yes-no?): New function. * tests/gpgscm/tests.scm (pathsep-split): Likewise. (pathsep-join): Likewise. (with-path): Use the new function. Signed-off-by: Justus Winter --- tests/gpgscm/repl.scm | 12 ++++++++++++ tests/gpgscm/tests.scm | 12 +++++++++++- 2 files changed, 23 insertions(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/gpgscm/repl.scm b/tests/gpgscm/repl.scm index 84454dc7c..833ec0dec 100644 --- a/tests/gpgscm/repl.scm +++ b/tests/gpgscm/repl.scm @@ -55,3 +55,15 @@ (define (interactive-repl . environment) (repl (lambda (p) (prompt-append-prefix "gpgscm " p)) (if (null? environment) (interaction-environment) (car environment)))) + +;; Ask a yes/no question. +(define (prompt-yes-no? question default) + (let ((answer (prompt (string-append question "? [" + (if default "Y/n" "y/N") "] ")))) + (cond + ((= 0 (string-length answer)) + default) + ((or (equal? "y" answer) (equal? "Y" answer)) + #t) + (else + #f)))) diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm index 06084dea9..40ba7e394 100644 --- a/tests/gpgscm/tests.scm +++ b/tests/gpgscm/tests.scm @@ -192,6 +192,16 @@ (define (in-srcdir . names) (canonical-path (apply path-join (cons (getenv "abs_top_srcdir") names)))) +;; Split a list of paths. +(define (pathsep-split s) + (string-split s *pathsep*)) + +;; Join a list of paths. +(define (pathsep-join paths) + (foldr (lambda (a b) (string-append a (string *pathsep*) b)) + (car paths) + (cdr paths))) + ;; Try to find NAME in PATHS. Returns the full path name on success, ;; or raises an error. (define (path-expand name paths) @@ -209,7 +219,7 @@ ;; (load (with-path "library.scm")) (define (with-path name) (catch name - (path-expand name (string-split (getenv "GPGSCM_PATH") *pathsep*)))) + (path-expand name (pathsep-split (getenv "GPGSCM_PATH"))))) (define (basename path) (let ((i (string-index path #\/))) -- cgit v1.2.3