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 (dictionary-size+match-length-limit %default-compression-level)))))
  91
  92 (test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB)"
  93   (compress-and-decompress (random-bytevector (* 64 1024))))
  94
  95 (test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB-1)"
  96   (compress-and-decompress (random-bytevector (1- (* 64 1024)))))
  97
  98 (test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB+1)"
  99   (compress-and-decompress (random-bytevector (1+ (* 64 1024)))))
 100
 101 (test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB)"
 102   (compress-and-decompress (random-bytevector (* 1024 1024))))
 103
 104 (test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB-1)"
 105   (compress-and-decompress (random-bytevector (1- (* 1024 1024)))))
 106
 107 (test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB+1)"
 108   (compress-and-decompress (random-bytevector (1+ (* 1024 1024)))))
 109
 110 (test-assert* "make-lzip-input-port/compressed"
 111   (let* ((len        (pk 'len (+ 10 (random 4000 %seed))))
 112          (data       (random-bytevector len))
 113          (compressed (make-lzip-input-port/compressed
 114                       (open-bytevector-input-port data)))
 115          (result     (call-with-lzip-input-port compressed
 116                                                 get-bytevector-all)))
 117     (pk (bytevector-length result) (bytevector-length data))
 118     (bytevector=? result data)))
 119
 120 (test-end)