[gnutls-devel] [PATCH 3/8] guile: tests: Add Guile 2.2 compatibility layer.

[Ludovic Courtès]

This allows tests to run with Guile 2.1/2.2.

* guile/modules/gnutls/build/tests.scm (define-replacement) [guile-2]:
New macro.
(uniform-vector-read!, uniform-vector-write) [guile-2]: New procedures.
* doc/gnutls-guile.texi (Guile Preparations): Mention 2.2.
---
 doc/gnutls-guile.texi                |  6 +++---
 guile/modules/gnutls/build/tests.scm | 29 +++++++++++++++++++++++++++--
 2 files changed, 30 insertions(+), 5 deletions(-)

diff --git a/doc/gnutls-guile.texi b/doc/gnutls-guile.texi
index 80b03ca..4bc04ad 100644
--- a/doc/gnutls-guile.texi
+++ b/doc/gnutls-guile.texi
@@ -17,7 +17,7 @@
 This manual is last updated @value{UPDATED} for version
 @value{VERSION} of GnuTLS.
 
-Copyright @copyright{} 2001-2012, 2014 Free Software Foundation, Inc.
+Copyright @copyright{} 2001-2012, 2014, 2016 Free Software Foundation, Inc.
 
 @quotation
 Permission is granted to copy, distribute and/or modify this document
@@ -85,8 +85,8 @@ a large subset thereof is available.
 @node Guile Preparations
 @chapter Guile Preparations
 
-The GnuTLS Guile bindings are available for both the 1.8 and 2.0 stable
-series of Guile.
+The GnuTLS Guile bindings are available for Guile's 2.0 stable series,
+as well as the forthcoming 2.2 series and the legacy 1.8 series.
 
 By default they are installed under the GnuTLS installation directory,
 typically @file{/usr/local/share/guile/site/}).  Normally Guile
diff --git a/guile/modules/gnutls/build/tests.scm b/guile/modules/gnutls/build/tests.scm
index 5a03ce7..2fe6be2 100644
--- a/guile/modules/gnutls/build/tests.scm
+++ b/guile/modules/gnutls/build/tests.scm
@@ -67,8 +67,29 @@ process exits upon failure."
             ((_ args ...) body))))))
 
    (export define-syntax-rule))
-  (else
-   #t))
+
+  (else                                           ;2.0 and 2.2
+   (use-modules (rnrs io ports)
+                (rnrs bytevectors))
+
+   (define-syntax-rule (define-replacement (name args ...) body ...)
+     ;; Define a compatibility replacement for NAME, if needed.
+     (define-public name
+       (if (module-defined? the-scm-module 'name)
+           (module-ref the-scm-module 'name)
+           (lambda (args ...)
+             body ...))))
+
+   ;; 'uniform-vector-read!' and 'uniform-vector-write' are deprecated in 2.0
+   ;; and absent in 2.2.
+
+   (define-replacement (uniform-vector-read! buf port)
+     (get-bytevector-n! port buf
+                        0 (bytevector-length buf)))
+
+   (define-replacement (uniform-vector-write buf port)
+     (put-bytevector port buf))))
+
 
 (define-syntax-rule (with-child-process pid parent child)
   "Fork and evaluate expression PARENT in the current process, with PID bound
@@ -76,3 +97,7 @@ to the PID of its child process; the child process evaluated CHILD."
   (call-with-child-process
    (lambda () child)
    (lambda (pid) parent)))
+
+;;; Local Variables:
+;;; eval: (put 'define-replacement 'scheme-indent-function 1)
+;;; End:
-- 
2.6.3