diff options
author | Mathieu Othacehe <othacehe@gnu.org> | 2020-08-26 18:35:14 +0200 |
---|---|---|
committer | Mathieu Othacehe <othacehe@gnu.org> | 2020-08-26 18:35:14 +0200 |
commit | 17dddeeee560527a8f30d37761949d658056cb09 (patch) | |
tree | 15b0b19c55787f556eb9b42c28d173bddc5435db /tests/lzlib.scm | |
parent | 331a09654eb7e9f6212b7e8469077fa7393e8b11 (diff) | |
parent | 6a9581741e4ee81226aeb2f1c997df76670a6aab (diff) | |
download | guix-patches-17dddeeee560527a8f30d37761949d658056cb09.tar guix-patches-17dddeeee560527a8f30d37761949d658056cb09.tar.gz |
Merge remote-tracking branch 'origin/master' into core-updates
Diffstat (limited to 'tests/lzlib.scm')
-rw-r--r-- | tests/lzlib.scm | 120 |
1 files changed, 0 insertions, 120 deletions
diff --git a/tests/lzlib.scm b/tests/lzlib.scm deleted file mode 100644 index 63d1e15641..0000000000 --- a/tests/lzlib.scm +++ /dev/null @@ -1,120 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz> -;;; -;;; 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-lzlib) - #:use-module (guix lzlib) - #: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 lzlib) module. - -(define-syntax-rule (test-assert* description exp) - (begin - (unless (lzlib-available?) - (test-skip 1)) - (test-assert description exp))) - -(test-begin "lzlib") - -(define (compress-and-decompress data) - "DATA must be a bytevector." - (pk "Uncompressed bytes:" (bytevector-length data)) - (match (pipe) - ((parent . child) - (match (primitive-fork) - (0 ;compress - (dynamic-wind - (const #t) - (lambda () - (close-port parent) - (call-with-lzip-output-port child - (lambda (port) - (put-bytevector port data)))) - (lambda () - (primitive-exit 0)))) - (pid ;decompress - (begin - (close-port child) - (let ((received (call-with-lzip-input-port parent - (lambda (port) - (get-bytevector-all port))))) - (match (waitpid pid) - ((_ . status) - (pk "Status" status) - (pk "Length data" (bytevector-length data) "received" (bytevector-length received)) - ;; The following loop is a debug helper. - (let loop ((i 0)) - (if (and (< i (bytevector-length received)) - (= (bytevector-u8-ref received i) - (bytevector-u8-ref data i))) - (loop (+ 1 i)) - (pk "First diff at index" i))) - (and (zero? status) - (port-closed? parent) - (bytevector=? received data))))))))))) - -(test-assert* "null bytevector" - (compress-and-decompress (make-bytevector (+ (random 100000) - (* 20 1024))))) - -(test-assert* "random bytevector" - (compress-and-decompress (random-bytevector (+ (random 100000) - (* 20 1024))))) -(test-assert* "small bytevector" - (compress-and-decompress (random-bytevector 127))) - -(test-assert* "1 bytevector" - (compress-and-decompress (random-bytevector 1))) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (2 * dictionary)" - (compress-and-decompress - (random-bytevector - (* 2 (dictionary-size+match-length-limit %default-compression-level))))) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB)" - (compress-and-decompress (random-bytevector (* 64 1024)))) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB-1)" - (compress-and-decompress (random-bytevector (1- (* 64 1024))))) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (64KiB+1)" - (compress-and-decompress (random-bytevector (1+ (* 64 1024))))) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB)" - (compress-and-decompress (random-bytevector (* 1024 1024)))) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB-1)" - (compress-and-decompress (random-bytevector (1- (* 1024 1024))))) - -(test-assert* "Bytevector of size relative to Lzip internal buffers (1MiB+1)" - (compress-and-decompress (random-bytevector (1+ (* 1024 1024))))) - -(test-assert* "make-lzip-input-port/compressed" - (let* ((len (pk 'len (+ 10 (random 4000 %seed)))) - (data (random-bytevector len)) - (compressed (make-lzip-input-port/compressed - (open-bytevector-input-port data))) - (result (call-with-lzip-input-port compressed - get-bytevector-all))) - (pk (bytevector-length result) (bytevector-length data)) - (bytevector=? result data))) - -(test-end) |