tests/zlib.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (test-zlib)
  20   #:use-module (guix zlib)
  21   #:use-module (guix tests)
  22   #:use-module (srfi srfi-64)
  23   #:use-module (rnrs bytevectors)
  24   #:use-module (rnrs io ports)
  25   #:use-module (ice-9 match))
  26
  27 ;; Test the (guix zlib) module.
  28
  29 (unless (zlib-available?)
  30   (exit 77))
  31
  32 (test-begin "zlib")
  33
  34 (test-assert "compression/decompression pipe"
  35   (let ((data (random-bytevector (+ (random 10000)
  36                                     (* 20 1024)))))
  37     (match (pipe)
  38       ((parent . child)
  39        (match (primitive-fork)
  40          (0                                       ;compress
  41           (dynamic-wind
  42             (const #t)
  43             (lambda ()
  44               (close-port parent)
  45               (call-with-gzip-output-port child
  46                 (lambda (port)
  47                   (put-bytevector port data))))
  48             (lambda ()
  49               (primitive-exit 0))))
  50          (pid                                     ;decompress
  51           (begin
  52             (close-port child)
  53             (let ((received (call-with-gzip-input-port parent
  54                               (lambda (port)
  55                                 (get-bytevector-all port))
  56                               #:buffer-size (* 64 1024))))
  57               (match (waitpid pid)
  58                 ((_ . status)
  59                  (and (zero? status)
  60                       (port-closed? parent)
  61                       (bytevector=? received data))))))))))))
  62
  63 (test-end)