From 721539026dda02e58addbb618f2102b31a2927f8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 18 Jul 2016 23:14:14 +0200
Subject: Add (guix zlib).

* guix/zlib.scm, tests/zlib.scm: New files.
* Makefile.am (MODULES): Add guix/zlib.scm.
(SCM_TESTS): Add tests/zlib.scm.
* m4/guix.m4 (GUIX_LIBGCRYPT_LIBDIR): New macro.
* configure.ac (LIBGCRYPT_LIBDIR): Use it.  Define and substitute
'LIBZ'.
* guix/config.scm.in (%libz): New variable.
---
 tests/zlib.scm | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)
 create mode 100644 tests/zlib.scm

(limited to 'tests')

diff --git a/tests/zlib.scm b/tests/zlib.scm
new file mode 100644
index 0000000000..5455240a71
--- /dev/null
+++ b/tests/zlib.scm
@@ -0,0 +1,63 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix 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.
+;;;
+;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-zlib)
+  #:use-module (guix zlib)
+  #:use-module (guix tests)
+  #:use-module (srfi srfi-64)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports)
+  #:use-module (ice-9 match))
+
+;; Test the (guix zlib) module.
+
+(unless (zlib-available?)
+  (exit 77))
+
+(test-begin "zlib")
+
+(test-assert "compression/decompression pipe"
+  (let ((data (random-bytevector (+ (random 10000)
+                                    (* 20 1024)))))
+    (match (pipe)
+      ((parent . child)
+       (match (primitive-fork)
+         (0                                       ;compress
+          (dynamic-wind
+            (const #t)
+            (lambda ()
+              (close-port parent)
+              (call-with-gzip-output-port child
+                (lambda (port)
+                  (put-bytevector port data))))
+            (lambda ()
+              (primitive-exit 0))))
+         (pid                                     ;decompress
+          (begin
+            (close-port child)
+            (let ((received (call-with-gzip-input-port parent
+                              (lambda (port)
+                                (get-bytevector-all port))
+                              #:buffer-size (* 64 1024))))
+              (match (waitpid pid)
+                ((_ . status)
+                 (and (zero? status)
+                      (port-closed? parent)
+                      (bytevector=? received data))))))))))))
+
+(test-end)
-- 
cgit v1.2.3