tests/zlib.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016, 2019 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 (test-begin "zlib")
  30
  31 (unless (zlib-available?)
  32   (test-skip 1))
  33 (test-assert "compression/decompression pipe"
  34   (let ((data (random-bytevector (+ (random 10000)
  35                                     (* 20 1024)))))
  36     (match (pipe)
  37       ((parent . child)
  38        (match (primitive-fork)
  39          (0                                       ;compress
  40           (dynamic-wind
  41             (const #t)
  42             (lambda ()
  43               (close-port parent)
  44               (call-with-gzip-output-port child
  45                 (lambda (port)
  46                   (put-bytevector port data))))
  47             (lambda ()
  48               (primitive-exit 0))))
  49          (pid                                     ;decompress
  50           (begin
  51             (close-port child)
  52             (let ((received (call-with-gzip-input-port parent
  53                               (lambda (port)
  54                                 (get-bytevector-all port))
  55                               #:buffer-size (* 64 1024))))
  56               (match (waitpid pid)
  57                 ((_ . status)
  58                  (and (zero? status)
  59                       (port-closed? parent)
  60                       (bytevector=? received data))))))))))))
  61
  62 (test-end)