tests/gpgscm: Add a TinySCHEME-based test driver.

* configure.ac: Add new component.
* tests/Makefile.am: Likewise.
* tests/gpgscm/Makefile.am: New file.
* tests/gpgscm/ffi-private.h: Likewise.
* tests/gpgscm/ffi.c: Likewise.
* tests/gpgscm/ffi.h: Likewise.
* tests/gpgscm/ffi.scm: Likewise.
* tests/gpgscm/lib.scm: Likewise.
* tests/gpgscm/main.c: Likewise.
* tests/gpgscm/private.h: Likewise.
* tests/gpgscm/repl.scm: Likewise.
* tests/gpgscm/scheme-config.h: Likewise.
* tests/gpgscm/t-child.c: Likewise.
* tests/gpgscm/t-child.scm: Likewise.
* tests/gpgscm/tests.scm: Likewise.

Signed-off-by: Justus Winter <justus@g10code.com>

tests/gpgscm/lib.scm

@@ -0,0 +1,163 @@
+;; Additional library functions for TinySCHEME.
+;;
+;; Copyright (C) 2016 g10 Code GmbH
+;;
+;; This file is part of GnuPG.
+;;
+;; GnuPG is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GnuPG is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, see <http://www.gnu.org/licenses/>.
+
+(macro (assert form)
+  `(if (not ,(cadr form))
+       (begin
+	 (display (list "Assertion failed:" (quote ,(cadr form))))
+	 (newline)
+	 (exit 1))))
+(assert #t)
+
+(define (filter pred lst)
+  (cond ((null? lst) '())
+        ((pred (car lst))
+         (cons (car lst) (filter pred (cdr lst))))
+        (else (filter pred (cdr lst)))))
+
+(define (any p l)
+  (cond ((null? l) #f)
+        ((p (car l)) #t)
+        (else (any p (cdr l)))))
+
+(define (all p l)
+  (cond ((null? l) #t)
+        ((not (p (car l))) #f)
+        (else (all p (cdr l)))))
+
+;; Is PREFIX a prefix of S?
+(define (string-prefix? s prefix)
+  (and (>= (string-length s) (string-length prefix))
+       (string=? prefix (substring s 0 (string-length prefix)))))
+(assert (string-prefix? "Scheme" "Sch"))
+
+;; Is SUFFIX a suffix of S?
+(define (string-suffix? s suffix)
+  (and (>= (string-length s) (string-length suffix))
+       (string=? suffix (substring s (- (string-length s)
+					(string-length suffix))
+				   (string-length s)))))
+(assert (string-suffix? "Scheme" "eme"))
+
+;; Locate the first occurrence of needle in haystack.
+(define (string-index haystack needle)
+  (define (index i haystack needle)
+    (if (= (length haystack) 0)
+        #f
+        (if (char=? (car haystack) needle)
+            i
+            (index (+ i 1) (cdr haystack) needle))))
+  (index 0 (string->list haystack) needle))
+
+;; Locate the last occurrence of needle in haystack.
+(define (string-rindex haystack needle)
+  (let ((rindex (string-index (list->string (reverse (string->list haystack)))
+			      needle)))
+    (if rindex (- (string-length haystack) rindex 1) #f)))
+
+;; Split haystack at delimiter at most n times.
+(define (string-splitn haystack delimiter n)
+  (define (split acc haystack delimiter n)
+    (if (= (string-length haystack) 0)
+        (reverse acc)
+        (let ((i (string-index haystack delimiter)))
+          (if (not (or (eq? i #f) (= 0 n)))
+              (split (cons (substring haystack 0 i) acc)
+                     (substring haystack (+ i 1) (string-length haystack))
+                     delimiter (- n 1))
+              (split (cons haystack acc) "" delimiter 0)
+              ))))
+  (split '() haystack delimiter n))
+
+;; Split haystack at delimiter.
+(define (string-split haystack delimiter)
+  (string-splitn haystack delimiter -1))
+
+;; Trim the prefix of S containing only characters that make PREDICATE
+;; true.  For example (string-ltrim char-whitespace? "  foo") =>
+;; "foo".
+(define (string-ltrim predicate s)
+  (let loop ((s' (string->list s)))
+    (if (predicate (car s'))
+	(loop (cdr s'))
+	(list->string s'))))
+
+;; Trim the suffix of S containing only characters that make PREDICATE
+;; true.
+(define (string-rtrim predicate s)
+  (let loop ((s' (reverse (string->list s))))
+    (if (predicate (car s'))
+	(loop (cdr s'))
+	(list->string (reverse s')))))
+
+;; Trim both the prefix and suffix of S containing only characters
+;; that make PREDICATE true.
+(define (string-trim predicate s)
+  (string-ltrim predicate (string-rtrim predicate s)))
+
+(define (string-contains? s contained)
+  (let loop ((offset 0))
+    (if (<= (+ offset (string-length contained)) (string-length s))
+	(if (string=? (substring s offset (+ offset (string-length contained)))
+		      contained)
+	    #t
+	    (loop (+ 1 offset)))
+	#f)))
+
+(define (echo . msg)
+  (for-each (lambda (x) (display x) (display " ")) msg)
+  (newline))
+
+;; Read a word from port P.
+(define (read-word . p)
+  (list->string
+   (let f ()
+     (let ((c (apply peek-char p)))
+       (cond
+	((eof-object? c) '())
+	((char-alphabetic? c)
+	 (apply read-char p)
+	 (cons c (f)))
+	(else
+	 (apply read-char p)
+	 '()))))))
+
+;; Read a line from port P.
+(define (read-line . p)
+  (list->string
+   (let f ()
+     (let ((c (apply peek-char p)))
+       (cond
+	((eof-object? c) '())
+	((char=? c #\newline)
+	 (apply read-char p)
+	 '())
+	(else
+	 (apply read-char p)
+	 (cons c (f))))))))
+
+;; Read everything from port P.
+(define (read-all . p)
+  (list->string
+   (let f ()
+     (let ((c (apply peek-char p)))
+       (cond
+	((eof-object? c) '())
+	(else (apply read-char p)
+	 (cons c (f))))))))