tests/lzlib.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
   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-lzlib)
  20   #:use-module (guix lzlib)
  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 lzlib) module.
  28
  29 (define-syntax-rule (test-assert* description exp)
  30   (begin
  31     (unless (lzlib-available?)
  32       (test-skip 1))
  33     (test-assert description exp)))
  34
  35 (test-begin "lzlib")
  36
  37 (define (compress-and-decompress data)
  38   "DATA must be a bytevector."
  39   (pk "Uncompressed bytes:" (bytevector-length data))
  40   (match (pipe)
  41     ((parent . child)
  42      (match (primitive-fork)
  43        (0                               ;compress
  44         (dynamic-wind
  45           (const #t)
  46           (lambda ()
  47             (close-port parent)
  48             (call-with-lzip-output-port child
  49               (lambda (port)
  50                 (put-bytevector port data))))
  51           (lambda ()
  52             (primitive-exit 0))))
  53        (pid                             ;decompress
  54         (begin
  55           (close-port child)
  56           (let ((received (call-with-lzip-input-port parent
  57                             (lambda (port)
  58                               (get-bytevector-all port)))))
  59             (match (waitpid pid)
  60               ((_ . status)
  61                (pk "Status" status)
  62                (pk "Length data" (bytevector-length data) "received" (bytevector-length received))
  63                ;; The following loop is a debug helper.
  64                (let loop ((i 0))
  65                  (if (and (< i (bytevector-length received))
  66                           (= (bytevector-u8-ref received i)
  67                              (bytevector-u8-ref data i)))
  68                      (loop (+ 1 i))
  69                      (pk "First diff at index" i)))
  70                (and (zero? status)
  71                     (port-closed? parent)
  72                     (bytevector=? received data)))))))))))
  73
  74 (test-assert* "null bytevector"
  75   (compress-and-decompress (make-bytevector (+ (random 100000)
  76                                                (* 20 1024)))))
  77
  78 (test-assert* "random bytevector"
  79   (compress-and-decompress (random-bytevector (+ (random 100000)
  80                                                  (* 20 1024)))))
  81 (test-assert* "small bytevector"
  82   (compress-and-decompress (random-bytevector 127)))
  83
  84 (test-assert* "1 bytevector"
  85   (compress-and-decompress (random-bytevector 1)))
  86
  87 (test-assert* "Bytevector of size relative to Lzip internal buffers (2 * dictionary)"
  88   (compress-and-decompress
  89    (random-bytevector
  90     (* 2 (car (car (assoc-ref (@@ (guix lzlib) %compression-levels)
  91                               (@@ (guix lzlib) %default-compression-level))))))))
  92
  93 (test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB)"
  94   (compress-and-decompress (random-bytevector (* 64 1024))))
  95
  96 (test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB-1)"
  97   (compress-and-decompress (random-bytevector (1- (* 64 1024)))))
  98
  99 (test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB+1)"
 100   (compress-and-decompress (random-bytevector (1+ (* 64 1024)))))
 101
 102 (test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB)"
 103   (compress-and-decompress (random-bytevector (* 1024 1024))))
 104
 105 (test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB-1)"
 106   (compress-and-decompress (random-bytevector (1- (* 1024 1024)))))
 107
 108 (test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB+1)"
 109   (compress-and-decompress (random-bytevector (1+ (* 1024 1024)))))
 110
 111 (test-assert "make-lzip-input-port/compressed"
 112   (let* ((len        (pk 'len (+ 10 (random 4000 %seed))))
 113          (data       (random-bytevector len))
 114          (compressed (make-lzip-input-port/compressed
 115                       (open-bytevector-input-port data)))
 116          (result     (call-with-lzip-input-port compressed
 117                                                 get-bytevector-all)))
 118     (pk (bytevector-length result) (bytevector-length data))
 119     (bytevector=? result data)))
 120
 121 (test-end)