diff options
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | configure.ac | 10 | ||||
| -rw-r--r-- | guix/config.scm.in | 4 | ||||
| -rw-r--r-- | guix/lzlib.scm | 633 | ||||
| -rw-r--r-- | guix/self.scm | 1 | ||||
| -rw-r--r-- | m4/guix.m4 | 17 | ||||
| -rw-r--r-- | tests/lzlib.scm | 111 |
7 files changed, 777 insertions, 1 deletions
diff --git a/Makefile.am b/Makefile.am index 04944523861..9539fef1b13 100644 --- a/Makefile.am +++ b/Makefile.am | |||
| @@ -103,6 +103,7 @@ MODULES = \ | |||
| 103 | guix/cve.scm \ | 103 | guix/cve.scm \ |
| 104 | guix/workers.scm \ | 104 | guix/workers.scm \ |
| 105 | guix/zlib.scm \ | 105 | guix/zlib.scm \ |
| 106 | guix/lzlib.scm \ | ||
| 106 | guix/build-system.scm \ | 107 | guix/build-system.scm \ |
| 107 | guix/build-system/android-ndk.scm \ | 108 | guix/build-system/android-ndk.scm \ |
| 108 | guix/build-system/ant.scm \ | 109 | guix/build-system/ant.scm \ |
| @@ -404,6 +405,7 @@ SCM_TESTS = \ | |||
| 404 | tests/cve.scm \ | 405 | tests/cve.scm \ |
| 405 | tests/workers.scm \ | 406 | tests/workers.scm \ |
| 406 | tests/zlib.scm \ | 407 | tests/zlib.scm \ |
| 408 | tests/lzlib.scm \ | ||
| 407 | tests/file-systems.scm \ | 409 | tests/file-systems.scm \ |
| 408 | tests/uuid.scm \ | 410 | tests/uuid.scm \ |
| 409 | tests/system.scm \ | 411 | tests/system.scm \ |
diff --git a/configure.ac b/configure.ac index 7e7ae02730d..3918550a791 100644 --- a/configure.ac +++ b/configure.ac | |||
| @@ -250,6 +250,16 @@ AC_MSG_CHECKING([for zlib's shared library name]) | |||
| 250 | AC_MSG_RESULT([$LIBZ]) | 250 | AC_MSG_RESULT([$LIBZ]) |
| 251 | AC_SUBST([LIBZ]) | 251 | AC_SUBST([LIBZ]) |
| 252 | 252 | ||
| 253 | dnl Library name of lzlib suitable for 'dynamic-link'. | ||
| 254 | GUIX_LIBLZ_FILE_NAME([LIBLZ]) | ||
| 255 | if test "x$LIBLZ" = "x"; then | ||
| 256 | LIBLZ="liblz" | ||
| 257 | else | ||
| 258 | # Strip the .so or .so.1 extension since that's what 'dynamic-link' expects. | ||
| 259 | LIBLZ="`echo $LIBLZ | sed -es'/\.so\(\.[[0-9.]]\+\)\?//g'`" | ||
| 260 | fi | ||
| 261 | AC_SUBST([LIBLZ]) | ||
| 262 | |||
| 253 | dnl Check for Guile-SSH, for the (guix ssh) module. | 263 | dnl Check for Guile-SSH, for the (guix ssh) module. |
| 254 | GUIX_CHECK_GUILE_SSH | 264 | GUIX_CHECK_GUILE_SSH |
| 255 | AM_CONDITIONAL([HAVE_GUILE_SSH], | 265 | AM_CONDITIONAL([HAVE_GUILE_SSH], |
diff --git a/guix/config.scm.in b/guix/config.scm.in index 247b15ed818..0ada0f3c38c 100644 --- a/guix/config.scm.in +++ b/guix/config.scm.in | |||
| @@ -34,6 +34,7 @@ | |||
| 34 | 34 | ||
| 35 | %system | 35 | %system |
| 36 | %libz | 36 | %libz |
| 37 | %liblz | ||
| 37 | %gzip | 38 | %gzip |
| 38 | %bzip2 | 39 | %bzip2 |
| 39 | %xz)) | 40 | %xz)) |
| @@ -90,6 +91,9 @@ | |||
| 90 | (define %libz | 91 | (define %libz |
| 91 | "@LIBZ@") | 92 | "@LIBZ@") |
| 92 | 93 | ||
| 94 | (define %liblz | ||
| 95 | "@LIBLZ@") | ||
| 96 | |||
| 93 | (define %gzip | 97 | (define %gzip |
| 94 | "@GZIP@") | 98 | "@GZIP@") |
| 95 | 99 | ||
diff --git a/guix/lzlib.scm b/guix/lzlib.scm new file mode 100644 index 00000000000..d596f0d95dd --- /dev/null +++ b/guix/lzlib.scm | |||
| @@ -0,0 +1,633 @@ | |||
| 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 (guix lzlib) | ||
| 20 | #:use-module (rnrs bytevectors) | ||
| 21 | #:use-module (rnrs arithmetic bitwise) | ||
| 22 | #:use-module (ice-9 binary-ports) | ||
| 23 | #:use-module (ice-9 match) | ||
| 24 | #:use-module (system foreign) | ||
| 25 | #:use-module (guix config) | ||
| 26 | #:export (lzlib-available? | ||
| 27 | make-lzip-input-port | ||
| 28 | make-lzip-output-port | ||
| 29 | call-with-lzip-input-port | ||
| 30 | call-with-lzip-output-port | ||
| 31 | %default-member-length-limit | ||
| 32 | %default-compression-level)) | ||
| 33 | |||
| 34 | ;;; Commentary: | ||
| 35 | ;;; | ||
| 36 | ;;; Bindings to the lzlib / liblz API. Some convenience functions are also | ||
| 37 | ;;; provided (see the export). | ||
| 38 | ;;; | ||
| 39 | ;;; While the bindings are complete, the convenience functions only support | ||
| 40 | ;;; single member archives. To decompress single member archives, we loop | ||
| 41 | ;;; until lz-decompress-read returns 0. This is simpler. To support multiple | ||
| 42 | ;;; members properly, we need (among others) to call lz-decompress-finish and | ||
| 43 | ;;; loop over lz-decompress-read until lz-decompress-finished? returns #t. | ||
| 44 | ;;; Otherwise a multi-member archive starting with an empty member would only | ||
| 45 | ;;; decompress the empty member and stop there, resulting in truncated output. | ||
| 46 | |||
| 47 | ;;; Code: | ||
| 48 | |||
| 49 | (define %lzlib | ||
| 50 | ;; File name of lzlib's shared library. When updating via 'guix pull', | ||
| 51 | ;; '%liblz' might be undefined so protect against it. | ||
| 52 | (delay (dynamic-link (if (defined? '%liblz) | ||
| 53 | %liblz | ||
| 54 | "liblz")))) | ||
| 55 | |||
| 56 | (define (lzlib-available?) | ||
| 57 | "Return true if lzlib is available, #f otherwise." | ||
| 58 | (false-if-exception (force %lzlib))) | ||
| 59 | |||
| 60 | (define (lzlib-procedure ret name parameters) | ||
| 61 | "Return a procedure corresponding to C function NAME in liblz, or #f if | ||
| 62 | either lzlib or the function could not be found." | ||
| 63 | (match (false-if-exception (dynamic-func name (force %lzlib))) | ||
| 64 | ((? pointer? ptr) | ||
| 65 | (pointer->procedure ret ptr parameters)) | ||
| 66 | (#f | ||
| 67 | #f))) | ||
| 68 | |||
| 69 | (define-wrapped-pointer-type <lz-decoder> | ||
| 70 | ;; Scheme counterpart of the 'LZ_Decoder' opaque type. | ||
| 71 | lz-decoder? | ||
| 72 | pointer->lz-decoder | ||
| 73 | lz-decoder->pointer | ||
| 74 | (lambda (obj port) | ||
| 75 | (format port "#<lz-decoder ~a>" | ||
| 76 | (number->string (object-address obj) 16)))) | ||
| 77 | |||
| 78 | (define-wrapped-pointer-type <lz-encoder> | ||
| 79 | ;; Scheme counterpart of the 'LZ_Encoder' opaque type. | ||
| 80 | lz-encoder? | ||
| 81 | pointer->lz-encoder | ||
| 82 | lz-encoder->pointer | ||
| 83 | (lambda (obj port) | ||
| 84 | (format port "#<lz-encoder ~a>" | ||
| 85 | (number->string (object-address obj) 16)))) | ||
| 86 | |||
| 87 | ;; From lzlib.h | ||
| 88 | (define %error-number-ok 0) | ||
| 89 | (define %error-number-bad-argument 1) | ||
| 90 | (define %error-number-mem-error 2) | ||
| 91 | (define %error-number-sequence-error 3) | ||
| 92 | (define %error-number-header-error 4) | ||
| 93 | (define %error-number-unexpected-eof 5) | ||
| 94 | (define %error-number-data-error 6) | ||
| 95 | (define %error-number-library-error 7) | ||
| 96 | |||
| 97 | |||
| 98 | ;; Compression bindings. | ||
| 99 | |||
| 100 | (define lz-compress-open | ||
| 101 | (let ((proc (lzlib-procedure '* "LZ_compress_open" (list int int uint64))) | ||
| 102 | ;; member-size is an "unsigned long long", and the C standard guarantees | ||
| 103 | ;; a minimum range of 0..2^64-1. | ||
| 104 | (unlimited-size (- (expt 2 64) 1))) | ||
| 105 | (lambda* (dictionary-size match-length-limit #:optional (member-size unlimited-size)) | ||
| 106 | "Initialize the internal stream state for compression and returns a | ||
| 107 | pointer that can only be used as the encoder argument for the other | ||
| 108 | lz-compress functions, or a null pointer if the encoder could not be | ||
| 109 | allocated. | ||
| 110 | |||
| 111 | See the manual: (lzlib) Compression functions." | ||
| 112 | (let ((encoder-ptr (proc dictionary-size match-length-limit member-size))) | ||
| 113 | (if (not (= (lz-compress-error encoder-ptr) -1)) | ||
| 114 | (pointer->lz-encoder encoder-ptr) | ||
| 115 | (throw 'lzlib-error 'lz-compress-open)))))) | ||
| 116 | |||
| 117 | (define lz-compress-close | ||
| 118 | (let ((proc (lzlib-procedure int "LZ_compress_close" '(*)))) | ||
| 119 | (lambda (encoder) | ||
| 120 | "Close encoder. ENCODER can no longer be used as an argument to any | ||
| 121 | lz-compress function. " | ||
| 122 | (let ((ret (proc (lz-encoder->pointer encoder)))) | ||
| 123 | (if (= ret -1) | ||
| 124 | (throw 'lzlib-error 'lz-compress-close ret) | ||
| 125 | ret))))) | ||
| 126 | |||
| 127 | (define lz-compress-finish | ||
| 128 | (let ((proc (lzlib-procedure int "LZ_compress_finish" '(*)))) | ||
| 129 | (lambda (encoder) | ||
| 130 | "Tell that all the data for this member have already been written (with | ||
| 131 | the `lz-compress-write' function). It is safe to call `lz-compress-finish' as | ||
| 132 | many times as needed. After all the produced compressed data have been read | ||
| 133 | with `lz-compress-read' and `lz-compress-member-finished?' returns #t, a new | ||
| 134 | member can be started with 'lz-compress-restart-member'." | ||
| 135 | (let ((ret (proc (lz-encoder->pointer encoder)))) | ||
| 136 | (if (= ret -1) | ||
| 137 | (throw 'lzlib-error 'lz-compress-finish (lz-compress-error encoder)) | ||
| 138 | ret))))) | ||
| 139 | |||
| 140 | (define lz-compress-restart-member | ||
| 141 | (let ((proc (lzlib-procedure int "LZ_compress_restart_member" (list '* uint64)))) | ||
| 142 | (lambda (encoder member-size) | ||
| 143 | "Start a new member in a multimember data stream. | ||
| 144 | Call this function only after `lz-compress-member-finished?' indicates that the | ||
| 145 | current member has been fully read (with the `lz-compress-read' function)." | ||
| 146 | (let ((ret (proc (lz-encoder->pointer encoder) member-size))) | ||
| 147 | (if (= ret -1) | ||
| 148 | (throw 'lzlib-error 'lz-compress-restart-member | ||
| 149 | (lz-compress-error encoder)) | ||
| 150 | ret))))) | ||
| 151 | |||
| 152 | (define lz-compress-sync-flush | ||
| 153 | (let ((proc (lzlib-procedure int "LZ_compress_sync_flush" (list '*)))) | ||
| 154 | (lambda (encoder) | ||
| 155 | "Make available to `lz-compress-read' all the data already written with | ||
| 156 | the `LZ-compress-write' function. First call `lz-compress-sync-flush'. Then | ||
| 157 | call 'lz-compress-read' until it returns 0. | ||
| 158 | |||
| 159 | Repeated use of `LZ-compress-sync-flush' may degrade compression ratio, | ||
| 160 | so use it only when needed. " | ||
| 161 | (let ((ret (proc (lz-encoder->pointer encoder)))) | ||
| 162 | (if (= ret -1) | ||
| 163 | (throw 'lzlib-error 'lz-compress-sync-flush | ||
| 164 | (lz-compress-error encoder)) | ||
| 165 | ret))))) | ||
| 166 | |||
| 167 | (define lz-compress-read | ||
| 168 | (let ((proc (lzlib-procedure int "LZ_compress_read" (list '* '* int)))) | ||
| 169 | (lambda* (encoder lzfile-bv #:optional (start 0) (count (bytevector-length lzfile-bv))) | ||
| 170 | "Read up to COUNT bytes from the encoder stream, storing the results in LZFILE-BV. | ||
| 171 | Return the number of uncompressed bytes written, a strictly positive integer." | ||
| 172 | (let ((ret (proc (lz-encoder->pointer encoder) | ||
| 173 | (bytevector->pointer lzfile-bv start) | ||
| 174 | count))) | ||
| 175 | (if (= ret -1) | ||
| 176 | (throw 'lzlib-error 'lz-compress-read (lz-compress-error encoder)) | ||
| 177 | ret))))) | ||
| 178 | |||
| 179 | (define lz-compress-write | ||
| 180 | (let ((proc (lzlib-procedure int "LZ_compress_write" (list '* '* int)))) | ||
| 181 | (lambda* (encoder bv #:optional (start 0) (count (bytevector-length bv))) | ||
| 182 | "Write up to COUNT bytes from BV to the encoder stream. Return the | ||
| 183 | number of uncompressed bytes written, a strictly positive integer." | ||
| 184 | (let ((ret (proc (lz-encoder->pointer encoder) | ||
| 185 | (bytevector->pointer bv start) | ||
| 186 | count))) | ||
| 187 | (if (< ret 0) | ||
| 188 | (throw 'lzlib-error 'lz-compress-write (lz-compress-error encoder)) | ||
| 189 | ret))))) | ||
| 190 | |||
| 191 | (define lz-compress-write-size | ||
| 192 | (let ((proc (lzlib-procedure int "LZ_compress_write_size" '(*)))) | ||
| 193 | (lambda (encoder) | ||
| 194 | "The maximum number of bytes that can be immediately written through the | ||
| 195 | `lz-compress-write' function. | ||
| 196 | |||
| 197 | It is guaranteed that an immediate call to `lz-compress-write' will accept a | ||
| 198 | SIZE up to the returned number of bytes. " | ||
| 199 | (let ((ret (proc (lz-encoder->pointer encoder)))) | ||
| 200 | (if (= ret -1) | ||
| 201 | (throw 'lzlib-error 'lz-compress-write-size (lz-compress-error encoder)) | ||
| 202 | ret))))) | ||
| 203 | |||
| 204 | (define lz-compress-error | ||
| 205 | (let ((proc (lzlib-procedure int "LZ_compress_errno" '(*)))) | ||
| 206 | (lambda (encoder) | ||
| 207 | "ENCODER can be a Scheme object or a pointer." | ||
| 208 | (let* ((error-number (proc (if (lz-encoder? encoder) | ||
| 209 | (lz-encoder->pointer encoder) | ||
| 210 | encoder)))) | ||
| 211 | error-number)))) | ||
| 212 | |||
| 213 | (define lz-compress-finished? | ||
| 214 | (let ((proc (lzlib-procedure int "LZ_compress_finished" '(*)))) | ||
| 215 | (lambda (encoder) | ||
| 216 | "Return #t if all the data have been read and `lz-compress-close' can | ||
| 217 | be safely called. Otherwise return #f." | ||
| 218 | (let ((ret (proc (lz-encoder->pointer encoder)))) | ||
| 219 | (match ret | ||
| 220 | (1 #t) | ||
| 221 | (0 #f) | ||
| 222 | (_ (throw 'lzlib-error 'lz-compress-finished? (lz-compress-error encoder)))))))) | ||
| 223 | |||
| 224 | (define lz-compress-member-finished? | ||
| 225 | (let ((proc (lzlib-procedure int "LZ_compress_member_finished" '(*)))) | ||
| 226 | (lambda (encoder) | ||
| 227 | "Return #t if the current member, in a multimember data stream, has | ||
| 228 | been fully read and 'lz-compress-restart-member' can be safely called. | ||
| 229 | Otherwise return #f." | ||
| 230 | (let ((ret (proc (lz-encoder->pointer encoder)))) | ||
| 231 | (match ret | ||
| 232 | (1 #t) | ||
| 233 | (0 #f) | ||
| 234 | (_ (throw 'lzlib-error 'lz-compress-member-finished? (lz-compress-error encoder)))))))) | ||
| 235 | |||
| 236 | (define lz-compress-data-position | ||
| 237 | (let ((proc (lzlib-procedure uint64 "LZ_compress_data_position" '(*)))) | ||
| 238 | (lambda (encoder) | ||
| 239 | "Return the number of input bytes already compressed in the current | ||
| 240 | member." | ||
| 241 | (let ((ret (proc (lz-encoder->pointer encoder)))) | ||
| 242 | (if (= ret -1) | ||
| 243 | (throw 'lzlib-error 'lz-compress-data-position | ||
| 244 | (lz-compress-error encoder)) | ||
| 245 | ret))))) | ||
| 246 | |||
| 247 | (define lz-compress-member-position | ||
| 248 | (let ((proc (lzlib-procedure uint64 "LZ_compress_member_position" '(*)))) | ||
| 249 | (lambda (encoder) | ||
| 250 | "Return the number of compressed bytes already produced, but perhaps | ||
| 251 | not yet read, in the current member." | ||
| 252 | (let ((ret (proc (lz-encoder->pointer encoder)))) | ||
| 253 | (if (= ret -1) | ||
| 254 | (throw 'lzlib-error 'lz-compress-member-position | ||
| 255 | (lz-compress-error encoder)) | ||
| 256 | ret))))) | ||
| 257 | |||
| 258 | (define lz-compress-total-in-size | ||
| 259 | (let ((proc (lzlib-procedure uint64 "LZ_compress_total_in_size" '(*)))) | ||
| 260 | (lambda (encoder) | ||
| 261 | "Return the total number of input bytes already compressed." | ||
| 262 | (let ((ret (proc (lz-encoder->pointer encoder)))) | ||
| 263 | (if (= ret -1) | ||
| 264 | (throw 'lzlib-error 'lz-compress-total-in-size | ||
| 265 | (lz-compress-error encoder)) | ||
| 266 | ret))))) | ||
| 267 | |||
| 268 | (define lz-compress-total-out-size | ||
| 269 | (let ((proc (lzlib-procedure uint64 "LZ_compress_total_out_size" '(*)))) | ||
| 270 | (lambda (encoder) | ||
| 271 | "Return the total number of compressed bytes already produced, but | ||
| 272 | perhaps not yet read." | ||
| 273 | (let ((ret (proc (lz-encoder->pointer encoder)))) | ||
| 274 | (if (= ret -1) | ||
| 275 | (throw 'lzlib-error 'lz-compress-total-out-size | ||
| 276 | (lz-compress-error encoder)) | ||
| 277 | ret))))) | ||
| 278 | |||
| 279 | |||
| 280 | ;; Decompression bindings. | ||
| 281 | |||
| 282 | (define lz-decompress-open | ||
| 283 | (let ((proc (lzlib-procedure '* "LZ_decompress_open" '()))) | ||
| 284 | (lambda () | ||
| 285 | "Initializes the internal stream state for decompression and returns a | ||
| 286 | pointer that can only be used as the decoder argument for the other | ||
| 287 | lz-decompress functions, or a null pointer if the decoder could not be | ||
| 288 | allocated. | ||
| 289 | |||
| 290 | See the manual: (lzlib) Decompression functions." | ||
| 291 | (let ((decoder-ptr (proc))) | ||
| 292 | (if (not (= (lz-decompress-error decoder-ptr) -1)) | ||
| 293 | (pointer->lz-decoder decoder-ptr) | ||
| 294 | (throw 'lzlib-error 'lz-decompress-open)))))) | ||
| 295 | |||
| 296 | (define lz-decompress-close | ||
| 297 | (let ((proc (lzlib-procedure int "LZ_decompress_close" '(*)))) | ||
| 298 | (lambda (decoder) | ||
| 299 | "Close decoder. DECODER can no longer be used as an argument to any | ||
| 300 | lz-decompress function. " | ||
| 301 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 302 | (if (= ret -1) | ||
| 303 | (throw 'lzlib-error 'lz-decompress-close ret) | ||
| 304 | ret))))) | ||
| 305 | |||
| 306 | (define lz-decompress-finish | ||
| 307 | (let ((proc (lzlib-procedure int "LZ_decompress_finish" '(*)))) | ||
| 308 | (lambda (decoder) | ||
| 309 | "Tell that all the data for this stream have already been written (with | ||
| 310 | the `lz-decompress-write' function). It is safe to call | ||
| 311 | `lz-decompress-finish' as many times as needed." | ||
| 312 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 313 | (if (= ret -1) | ||
| 314 | (throw 'lzlib-error 'lz-decompress-finish (lz-decompress-error decoder)) | ||
| 315 | ret))))) | ||
| 316 | |||
| 317 | (define lz-decompress-reset | ||
| 318 | (let ((proc (lzlib-procedure int "LZ_decompress_reset" '(*)))) | ||
| 319 | (lambda (decoder) | ||
| 320 | "Reset the internal state of DECODER as it was just after opening it | ||
| 321 | with the `lz-decompress-open' function. Data stored in the internal buffers | ||
| 322 | is discarded. Position counters are set to 0." | ||
| 323 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 324 | (if (= ret -1) | ||
| 325 | (throw 'lzlib-error 'lz-decompress-reset | ||
| 326 | (lz-decompress-error decoder)) | ||
| 327 | ret))))) | ||
| 328 | |||
| 329 | (define lz-decompress-sync-to-member | ||
| 330 | (let ((proc (lzlib-procedure int "LZ_decompress_sync_to_member" '(*)))) | ||
| 331 | (lambda (decoder) | ||
| 332 | "Reset the error state of DECODER and enters a search state that lasts | ||
| 333 | until a new member header (or the end of the stream) is found. After a | ||
| 334 | successful call to `lz-decompress-sync-to-member', data written with | ||
| 335 | `lz-decompress-write' will be consumed and 'lz-decompress-read' will return 0 | ||
| 336 | until a header is found. | ||
| 337 | |||
| 338 | This function is useful to discard any data preceding the first member, or to | ||
| 339 | discard the rest of the current member, for example in case of a data | ||
| 340 | error. If the decoder is already at the beginning of a member, this function | ||
| 341 | does nothing." | ||
| 342 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 343 | (if (= ret -1) | ||
| 344 | (throw 'lzlib-error 'lz-decompress-sync-to-member | ||
| 345 | (lz-decompress-error decoder)) | ||
| 346 | ret))))) | ||
| 347 | |||
| 348 | (define lz-decompress-read | ||
| 349 | (let ((proc (lzlib-procedure int "LZ_decompress_read" (list '* '* int)))) | ||
| 350 | (lambda* (decoder file-bv #:optional (start 0) (count (bytevector-length file-bv))) | ||
| 351 | "Read up to COUNT bytes from the decoder stream, storing the results in FILE-BV. | ||
| 352 | Return the number of uncompressed bytes written, a non-negative positive integer." | ||
| 353 | (let ((ret (proc (lz-decoder->pointer decoder) | ||
| 354 | (bytevector->pointer file-bv start) | ||
| 355 | count))) | ||
| 356 | (if (< ret 0) | ||
| 357 | (throw 'lzlib-error 'lz-decompress-read (lz-decompress-error decoder)) | ||
| 358 | ret))))) | ||
| 359 | |||
| 360 | (define lz-decompress-write | ||
| 361 | (let ((proc (lzlib-procedure int "LZ_decompress_write" (list '* '* int)))) | ||
| 362 | (lambda* (decoder bv #:optional (start 0) (count (bytevector-length bv))) | ||
| 363 | "Write up to COUNT bytes from BV to the decoder stream. Return the | ||
| 364 | number of uncompressed bytes written, a non-negative integer." | ||
| 365 | (let ((ret (proc (lz-decoder->pointer decoder) | ||
| 366 | (bytevector->pointer bv start) | ||
| 367 | count))) | ||
| 368 | (if (< ret 0) | ||
| 369 | (throw 'lzlib-error 'lz-decompress-write (lz-decompress-error decoder)) | ||
| 370 | ret))))) | ||
| 371 | |||
| 372 | (define lz-decompress-write-size | ||
| 373 | (let ((proc (lzlib-procedure int "LZ_decompress_write_size" '(*)))) | ||
| 374 | (lambda (decoder) | ||
| 375 | "Return the maximum number of bytes that can be immediately written | ||
| 376 | through the `lz-decompress-write' function. | ||
| 377 | |||
| 378 | It is guaranteed that an immediate call to `lz-decompress-write' will accept a | ||
| 379 | SIZE up to the returned number of bytes. " | ||
| 380 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 381 | (if (= ret -1) | ||
| 382 | (throw 'lzlib-error 'lz-decompress-write-size (lz-decompress-error decoder)) | ||
| 383 | ret))))) | ||
| 384 | |||
| 385 | (define lz-decompress-error | ||
| 386 | (let ((proc (lzlib-procedure int "LZ_decompress_errno" '(*)))) | ||
| 387 | (lambda (decoder) | ||
| 388 | "DECODER can be a Scheme object or a pointer." | ||
| 389 | (let* ((error-number (proc (if (lz-decoder? decoder) | ||
| 390 | (lz-decoder->pointer decoder) | ||
| 391 | decoder)))) | ||
| 392 | error-number)))) | ||
| 393 | |||
| 394 | (define lz-decompress-finished? | ||
| 395 | (let ((proc (lzlib-procedure int "LZ_decompress_finished" '(*)))) | ||
| 396 | (lambda (decoder) | ||
| 397 | "Return #t if all the data have been read and `lz-decompress-close' can | ||
| 398 | be safely called. Otherwise return #f." | ||
| 399 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 400 | (match ret | ||
| 401 | (1 #t) | ||
| 402 | (0 #f) | ||
| 403 | (_ (throw 'lzlib-error 'lz-decompress-finished? (lz-decompress-error decoder)))))))) | ||
| 404 | |||
| 405 | (define lz-decompress-member-finished? | ||
| 406 | (let ((proc (lzlib-procedure int "LZ_decompress_member_finished" '(*)))) | ||
| 407 | (lambda (decoder) | ||
| 408 | "Return #t if the current member, in a multimember data stream, has | ||
| 409 | been fully read and `lz-decompress-restart-member' can be safely called. | ||
| 410 | Otherwise return #f." | ||
| 411 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 412 | (match ret | ||
| 413 | (1 #t) | ||
| 414 | (0 #f) | ||
| 415 | (_ (throw 'lzlib-error 'lz-decompress-member-finished? (lz-decompress-error decoder)))))))) | ||
| 416 | |||
| 417 | (define lz-decompress-member-version | ||
| 418 | (let ((proc (lzlib-procedure int "LZ_decompress_member_version" '(*)))) | ||
| 419 | (lambda (decoder) | ||
| 420 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 421 | "Return the version of current member from member header." | ||
| 422 | (if (= ret -1) | ||
| 423 | (throw 'lzlib-error 'lz-decompress-data-position | ||
| 424 | (lz-decompress-error decoder)) | ||
| 425 | ret))))) | ||
| 426 | |||
| 427 | (define lz-decompress-dictionary-size | ||
| 428 | (let ((proc (lzlib-procedure int "LZ_decompress_dictionary_size" '(*)))) | ||
| 429 | (lambda (decoder) | ||
| 430 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 431 | "Return the dictionary size of current member from member header." | ||
| 432 | (if (= ret -1) | ||
| 433 | (throw 'lzlib-error 'lz-decompress-member-position | ||
| 434 | (lz-decompress-error decoder)) | ||
| 435 | ret))))) | ||
| 436 | |||
| 437 | (define lz-decompress-data-crc | ||
| 438 | (let ((proc (lzlib-procedure unsigned-int "LZ_decompress_data_crc" '(*)))) | ||
| 439 | (lambda (decoder) | ||
| 440 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 441 | "Return the 32 bit Cyclic Redundancy Check of the data decompressed | ||
| 442 | from the current member. The returned value is valid only when | ||
| 443 | `lz-decompress-member-finished' returns #t. " | ||
| 444 | (if (= ret -1) | ||
| 445 | (throw 'lzlib-error 'lz-decompress-member-position | ||
| 446 | (lz-decompress-error decoder)) | ||
| 447 | ret))))) | ||
| 448 | |||
| 449 | (define lz-decompress-data-position | ||
| 450 | (let ((proc (lzlib-procedure uint64 "LZ_decompress_data_position" '(*)))) | ||
| 451 | (lambda (decoder) | ||
| 452 | "Return the number of decompressed bytes already produced, but perhaps | ||
| 453 | not yet read, in the current member." | ||
| 454 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 455 | (if (= ret -1) | ||
| 456 | (throw 'lzlib-error 'lz-decompress-data-position | ||
| 457 | (lz-decompress-error decoder)) | ||
| 458 | ret))))) | ||
| 459 | |||
| 460 | (define lz-decompress-member-position | ||
| 461 | (let ((proc (lzlib-procedure uint64 "LZ_decompress_member_position" '(*)))) | ||
| 462 | (lambda (decoder) | ||
| 463 | "Return the number of input bytes already decompressed in the current | ||
| 464 | member." | ||
| 465 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 466 | (if (= ret -1) | ||
| 467 | (throw 'lzlib-error 'lz-decompress-member-position | ||
| 468 | (lz-decompress-error decoder)) | ||
| 469 | ret))))) | ||
| 470 | |||
| 471 | (define lz-decompress-total-in-size | ||
| 472 | (let ((proc (lzlib-procedure uint64 "LZ_decompress_total_in_size" '(*)))) | ||
| 473 | (lambda (decoder) | ||
| 474 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 475 | "Return the total number of input bytes already compressed." | ||
| 476 | (if (= ret -1) | ||
| 477 | (throw 'lzlib-error 'lz-decompress-total-in-size | ||
| 478 | (lz-decompress-error decoder)) | ||
| 479 | ret))))) | ||
| 480 | |||
| 481 | (define lz-decompress-total-out-size | ||
| 482 | (let ((proc (lzlib-procedure uint64 "LZ_decompress_total_out_size" '(*)))) | ||
| 483 | (lambda (decoder) | ||
| 484 | (let ((ret (proc (lz-decoder->pointer decoder)))) | ||
| 485 | "Return the total number of compressed bytes already produced, but | ||
| 486 | perhaps not yet read." | ||
| 487 | (if (= ret -1) | ||
| 488 | (throw 'lzlib-error 'lz-decompress-total-out-size | ||
| 489 | (lz-decompress-error decoder)) | ||
| 490 | ret))))) | ||
| 491 | |||
| 492 | |||
| 493 | ;; High level functions. | ||
| 494 | (define %lz-decompress-input-buffer-size (* 64 1024)) | ||
| 495 | |||
| 496 | (define* (lzread! decoder file-port bv | ||
| 497 | #:optional (start 0) (count (bytevector-length bv))) | ||
| 498 | "Read up to COUNT bytes from FILE-PORT into BV at offset START. Return the | ||
| 499 | number of uncompressed bytes actually read; it is zero if COUNT is zero or if | ||
| 500 | the end-of-stream has been reached." | ||
| 501 | ;; WARNING: Because we don't alternate between lz-reads and lz-writes, we can't | ||
| 502 | ;; process more than %lz-decompress-input-buffer-size from the file-port. | ||
| 503 | (when (> count %lz-decompress-input-buffer-size) | ||
| 504 | (set! count %lz-decompress-input-buffer-size)) | ||
| 505 | (let* ((written 0) | ||
| 506 | (read 0) | ||
| 507 | (file-bv (get-bytevector-n file-port count))) | ||
| 508 | (unless (eof-object? file-bv) | ||
| 509 | (begin | ||
| 510 | (while (and (< 0 (lz-decompress-write-size decoder)) | ||
| 511 | (< written (bytevector-length file-bv))) | ||
| 512 | (set! written (+ written | ||
| 513 | (lz-decompress-write decoder file-bv written | ||
| 514 | (- (bytevector-length file-bv) written))))))) | ||
| 515 | (let loop ((rd 0)) | ||
| 516 | (if (< start (bytevector-length bv)) | ||
| 517 | (begin | ||
| 518 | (set! rd (lz-decompress-read decoder bv start (- (bytevector-length bv) start))) | ||
| 519 | (set! start (+ start rd)) | ||
| 520 | (set! read (+ read rd))) | ||
| 521 | (set! rd 0)) | ||
| 522 | (unless (= rd 0) | ||
| 523 | (loop rd))) | ||
| 524 | read)) | ||
| 525 | |||
| 526 | (define* (lzwrite encoder bv lz-port | ||
| 527 | #:optional (start 0) (count (bytevector-length bv))) | ||
| 528 | "Write up to COUNT bytes from BV at offset START into LZ-PORT. Return | ||
| 529 | the number of uncompressed bytes written, a non-negative integer." | ||
| 530 | (let ((written 0) | ||
| 531 | (read 0)) | ||
| 532 | (while (and (< 0 (lz-compress-write-size encoder)) | ||
| 533 | (< written count)) | ||
| 534 | (set! written (+ written | ||
| 535 | (lz-compress-write encoder bv (+ start written) (- count written))))) | ||
| 536 | (when (= written 0) | ||
| 537 | (lz-compress-finish encoder)) | ||
| 538 | (let ((lz-bv (make-bytevector written))) | ||
| 539 | (let loop ((rd 0)) | ||
| 540 | (set! rd (lz-compress-read encoder lz-bv 0 (bytevector-length lz-bv))) | ||
| 541 | (put-bytevector lz-port lz-bv 0 rd) | ||
| 542 | (set! read (+ read rd)) | ||
| 543 | (unless (= rd 0) | ||
| 544 | (loop rd)))) | ||
| 545 | ;; `written' is the total byte count of uncompressed data. | ||
| 546 | written)) | ||
| 547 | |||
| 548 | |||
| 549 | ;;; | ||
| 550 | ;;; Port interface. | ||
| 551 | ;;; | ||
| 552 | |||
| 553 | ;; Alist of (levels (dictionary-size match-length-limit)). 0 is the fastest. | ||
| 554 | ;; See bbexample.c in lzlib's source. | ||
| 555 | (define %compression-levels | ||
| 556 | `((0 (65535 16)) | ||
| 557 | (1 (,(bitwise-arithmetic-shift-left 1 20) 5)) | ||
| 558 | (2 (,(bitwise-arithmetic-shift-left 3 19) 6)) | ||
| 559 | (3 (,(bitwise-arithmetic-shift-left 1 21) 8)) | ||
| 560 | (4 (,(bitwise-arithmetic-shift-left 3 20) 12)) | ||
| 561 | (5 (,(bitwise-arithmetic-shift-left 1 22) 20)) | ||
| 562 | (6 (,(bitwise-arithmetic-shift-left 1 23) 36)) | ||
| 563 | (7 (,(bitwise-arithmetic-shift-left 1 24) 68)) | ||
| 564 | (8 (,(bitwise-arithmetic-shift-left 3 23) 132)) | ||
| 565 | (9 (,(bitwise-arithmetic-shift-left 1 25) 273)))) | ||
| 566 | |||
| 567 | (define %default-compression-level | ||
| 568 | 6) | ||
| 569 | |||
| 570 | (define* (make-lzip-input-port port) | ||
| 571 | "Return an input port that decompresses data read from PORT, a file port. | ||
| 572 | PORT is automatically closed when the resulting port is closed." | ||
| 573 | (define decoder (lz-decompress-open)) | ||
| 574 | |||
| 575 | (define (read! bv start count) | ||
| 576 | (lzread! decoder port bv start count)) | ||
| 577 | |||
| 578 | (make-custom-binary-input-port "lzip-input" read! #f #f | ||
| 579 | (lambda () | ||
| 580 | (lz-decompress-close decoder) | ||
| 581 | (close-port port)))) | ||
| 582 | |||
| 583 | (define* (make-lzip-output-port port | ||
| 584 | #:key | ||
| 585 | (level %default-compression-level)) | ||
| 586 | "Return an output port that compresses data at the given LEVEL, using PORT, | ||
| 587 | a file port, as its sink. PORT is automatically closed when the resulting | ||
| 588 | port is closed." | ||
| 589 | (define encoder (apply lz-compress-open | ||
| 590 | (car (assoc-ref %compression-levels level)))) | ||
| 591 | |||
| 592 | (define (write! bv start count) | ||
| 593 | (lzwrite encoder bv port start count)) | ||
| 594 | |||
| 595 | (make-custom-binary-output-port "lzip-output" write! #f #f | ||
| 596 | (lambda () | ||
| 597 | (lz-compress-finish encoder) | ||
| 598 | ;; "lz-read" the trailing metadata added by `lz-compress-finish'. | ||
| 599 | (let ((lz-bv (make-bytevector (* 64 1024)))) | ||
| 600 | (let loop ((rd 0)) | ||
| 601 | (set! rd (lz-compress-read encoder lz-bv 0 (bytevector-length lz-bv))) | ||
| 602 | (put-bytevector port lz-bv 0 rd) | ||
| 603 | (unless (= rd 0) | ||
| 604 | (loop rd)))) | ||
| 605 | (lz-compress-close encoder) | ||
| 606 | (close-port port)))) | ||
| 607 | |||
| 608 | (define* (call-with-lzip-input-port port proc) | ||
| 609 | "Call PROC with a port that wraps PORT and decompresses data read from it. | ||
| 610 | PORT is closed upon completion." | ||
| 611 | (let ((lzip (make-lzip-input-port port))) | ||
| 612 | (dynamic-wind | ||
| 613 | (const #t) | ||
| 614 | (lambda () | ||
| 615 | (proc lzip)) | ||
| 616 | (lambda () | ||
| 617 | (close-port lzip))))) | ||
| 618 | |||
| 619 | (define* (call-with-lzip-output-port port proc | ||
| 620 | #:key | ||
| 621 | (level %default-compression-level)) | ||
| 622 | "Call PROC with an output port that wraps PORT and compresses data. PORT is | ||
| 623 | close upon completion." | ||
| 624 | (let ((lzip (make-lzip-output-port port | ||
| 625 | #:level level))) | ||
| 626 | (dynamic-wind | ||
| 627 | (const #t) | ||
| 628 | (lambda () | ||
| 629 | (proc lzip)) | ||
| 630 | (lambda () | ||
| 631 | (close-port lzip))))) | ||
| 632 | |||
| 633 | ;;; lzlib.scm ends here | ||
diff --git a/guix/self.scm b/guix/self.scm index 7098e4ea29a..74ea65240cd 100644 --- a/guix/self.scm +++ b/guix/self.scm | |||
| @@ -925,6 +925,7 @@ Info manual." | |||
| 925 | %store-database-directory | 925 | %store-database-directory |
| 926 | %config-directory | 926 | %config-directory |
| 927 | %libz | 927 | %libz |
| 928 | ;; TODO: %liblz | ||
| 928 | %gzip | 929 | %gzip |
| 929 | %bzip2 | 930 | %bzip2 |
| 930 | %xz)) | 931 | %xz)) |
diff --git a/m4/guix.m4 b/m4/guix.m4 index 5c846f76180..d0c5ec0f083 100644 --- a/m4/guix.m4 +++ b/m4/guix.m4 | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | dnl GNU Guix --- Functional package management for GNU | 1 | dnl GNU Guix --- Functional package management for GNU |
| 2 | dnl Copyright © 2012, 2013, 2014, 2015, 2016, 2018 Ludovic Courtès <ludo@gnu.org> | 2 | dnl Copyright © 2012, 2013, 2014, 2015, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org> |
| 3 | dnl Copyright © 2014 Mark H Weaver <mhw@netris.org> | 3 | dnl Copyright © 2014 Mark H Weaver <mhw@netris.org> |
| 4 | dnl Copyright © 2017 Efraim Flashner <efraim@flashner.co.il> | 4 | dnl Copyright © 2017 Efraim Flashner <efraim@flashner.co.il> |
| 5 | dnl | 5 | dnl |
| @@ -312,6 +312,21 @@ AC_DEFUN([GUIX_LIBZ_LIBDIR], [ | |||
| 312 | $1="$guix_cv_libz_libdir" | 312 | $1="$guix_cv_libz_libdir" |
| 313 | ]) | 313 | ]) |
| 314 | 314 | ||
| 315 | dnl GUIX_LIBLZ_FILE_NAME VAR | ||
| 316 | dnl | ||
| 317 | dnl Attempt to determine liblz's absolute file name; store the result in VAR. | ||
| 318 | AC_DEFUN([GUIX_LIBLZ_FILE_NAME], [ | ||
| 319 | AC_REQUIRE([PKG_PROG_PKG_CONFIG]) | ||
| 320 | AC_CACHE_CHECK([lzlib's file name], | ||
| 321 | [guix_cv_liblz_libdir], | ||
| 322 | [old_LIBS="$LIBS" | ||
| 323 | LIBS="-llz" | ||
| 324 | AC_LINK_IFELSE([AC_LANG_SOURCE([int main () { return LZ_decompress_open(); }])], | ||
| 325 | [guix_cv_liblz_libdir="`ldd conftest$EXEEXT | grep liblz | sed '-es/.*=> \(.*\) .*$/\1/g'`"]) | ||
| 326 | LIBS="$old_LIBS"]) | ||
| 327 | $1="$guix_cv_liblz_libdir" | ||
| 328 | ]) | ||
| 329 | |||
| 315 | dnl GUIX_CURRENT_LOCALSTATEDIR | 330 | dnl GUIX_CURRENT_LOCALSTATEDIR |
| 316 | dnl | 331 | dnl |
| 317 | dnl Determine the localstatedir of an existing Guix installation and set | 332 | dnl Determine the localstatedir of an existing Guix installation and set |
diff --git a/tests/lzlib.scm b/tests/lzlib.scm new file mode 100644 index 00000000000..cf53a9417d5 --- /dev/null +++ b/tests/lzlib.scm | |||
| @@ -0,0 +1,111 @@ | |||
| 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-end) | ||
