Commit | Line | Data |
---|---|---|
fea338c6 PN |
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 | |
3597c039 | 90 | (* 2 (dictionary-size+match-length-limit %default-compression-level))))) |
fea338c6 PN |
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 | ||
2c5dd47c | 110 | (test-assert* "make-lzip-input-port/compressed" |
2a991f3a LC |
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 | ||
fea338c6 | 120 | (test-end) |