pax_global_header00006660000000000000000000000064146135330020014507gustar00rootroot0000000000000052 comment=474cee42116295bc0bd2acf12d4d6a766043090e guile-lzlib/000077500000000000000000000000001461353300200132725ustar00rootroot00000000000000guile-lzlib/.gitignore000066400000000000000000000014561461353300200152700ustar00rootroot00000000000000*.eps *.go *.log *.pdf *.png *.tar.xz *.tar.gz *.tmp *~ .#* \#*\# ,* /ABOUT-NLS /INSTALL /aclocal.m4 /autom4te.cache /build-aux/ar-lib /build-aux/compile /build-aux/config.guess /build-aux/config.rpath /build-aux/config.sub /build-aux/depcomp /build-aux/install-sh /build-aux/mdate-sh /build-aux/missing /build-aux/test-driver /build-aux/texinfo.tex /config.status /configure /doc/*.1 /doc/.dirstamp /doc/contributing.*.texi /doc/*.aux /doc/*.cp /doc/*.cps /doc/*.fn /doc/*.fns /doc/*.html /doc/*.info /doc/*.info-[0-9] /doc/*.ky /doc/*.pg /doc/*.toc /doc/*.t2p /doc/*.tp /doc/*.vr /doc/*.vrs /doc/stamp-vti /doc/version.texi /doc/version-*.texi /m4/* /pre-inst-env /test-env /test-tmp /tests/*.trs GPATH GRTAGS GTAGS Makefile Makefile.in config.cache stamp-h[0-9] tmp /.version /doc/stamp-[0-9] /lzlib/config.scm guile-lzlib/AUTHORS000066400000000000000000000001111461353300200143330ustar00rootroot00000000000000Contributers to Guile Zlib 0.1: Mathieu Othacehe guile-lzlib/COPYING000066400000000000000000000001531461353300200143240ustar00rootroot00000000000000This project's license is GPL 3+. You can read the full license at https://www.gnu.org/licenses/gpl.html. guile-lzlib/ChangeLog000066400000000000000000000000001461353300200150320ustar00rootroot00000000000000guile-lzlib/HACKING000066400000000000000000000017521461353300200142660ustar00rootroot00000000000000-*- mode: org; coding: utf-8; -*- #+TITLE: Hacking lzlib * Contributing By far the easiest way to hack on lzlib is to develop using Guix: #+BEGIN_SRC bash # Obtain the source code cd /path/to/source-code guix environment -l guix.scm # In the new shell, run: hall dist --execute && autoreconf -vif && ./configure && make check #+END_SRC You can now hack this project's files to your heart's content, whilst testing them from your `guix environment' shell. If you'd like to tidy the project again, but retain the ability to test the project from the commandline, simply run: #+BEGIN_SRC bash ./hall clean --skip "pre-inst-env" --execute #+END_SRC ** Manual Installation If you do not yet use Guix, you will have to install this project's dependencies manually: - autoconf - automake - pkg-config - texinfo - guile-hall - lzlib Once those dependencies are installed you can run: #+BEGIN_SRC bash hall dist -x && autoreconf -vif && ./configure && make check #+END_SRC guile-lzlib/Makefile.am000066400000000000000000000040401461353300200153240ustar00rootroot00000000000000 bin_SCRIPTS = # Handle substitution of fully-expanded Autoconf variables. do_subst = $(SED) \ -e 's,[@]GUILE[@],$(GUILE),g' \ -e 's,[@]guilemoduledir[@],$(guilemoduledir),g' \ -e 's,[@]guileobjectdir[@],$(guileobjectdir),g' \ -e 's,[@]localedir[@],$(localedir),g' nodist_noinst_SCRIPTS = pre-inst-env GOBJECTS = $(SOURCES:%.scm=%.go) moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION) godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache ccachedir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) nobase_go_DATA = $(GOBJECTS) # Make sure source files are installed first, so that the mtime of # installed compiled files is greater than that of installed source # files. See # # for details. guile_install_go_files = install-nobase_goDATA $(guile_install_go_files): install-nobase_modDATA EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat SUFFIXES = .scm .go .scm.go: $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_TARGET) $(GUILE_WARNINGS) -o "$@" "$<" SOURCES = lzlib.scm \ lzlib/config.scm TESTS = \ tests/lzlib.scm TEST_EXTENSIONS = .scm SCM_LOG_DRIVER = \ $(top_builddir)/pre-inst-env \ $(GUILE) --no-auto-compile -e main \ $(top_srcdir)/build-aux/test-driver.scm # Tell 'build-aux/test-driver.scm' to display only source file names, # not indivdual test names. AM_SCM_LOG_DRIVER_FLAGS = --brief=yes AM_SCM_LOG_FLAGS = --no-auto-compile -L "$(top_srcdir)" AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)" EXTRA_DIST += README.org \ README \ HACKING \ COPYING \ guix.scm \ hall.scm \ build-aux/test-driver.scm \ $(TESTS) clean-go: -$(RM) $(GOBJECTS) .PHONY: clean-go CLEANFILES = \ $(GOBJECTS) \ $(TESTS:tests/%.scm=%.log) guile-lzlib/NEWS000066400000000000000000000014711461353300200137740ustar00rootroot00000000000000 -*- org -*- #+TITLE: Guile-lzlib NEWS – history of user-visible changes #+STARTUP: content hidestars Copyright © 2024 Ludovic Courtès Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright notice and this notice are preserved. Please report bugs at . * Changes in 0.3.0 (compared to 0.0.2) ** Fix memory leak Ports returned by =make-lzip-output-port= and =make-lzip-input-port= would leak memory if not closed explicitly with =close-port=. In the case of =make-lzip-output-port=, the port would also leak memory when closed explicitly but the underlying port would throw an exception while writing to it. guile-lzlib/README000077700000000000000000000000001461353300200156132README.orgustar00rootroot00000000000000guile-lzlib/README.org000066400000000000000000000010031461353300200147320ustar00rootroot00000000000000-*- mode: org; coding: utf-8; -*- #+TITLE: README for Guile Lzlib * Guile-lzlib Guile-lzlib is a GNU Guile library providing bindings to [[https://www.nongnu.org/lzip/lzlib.html][lzlib]]. Copyright © 2020 Mathieu Othacehe Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright notice and this notice are preserved. This file is offered as-is, without any warranty. See [[./HACKING]] for build instructions. guile-lzlib/build-aux/000077500000000000000000000000001461353300200151645ustar00rootroot00000000000000guile-lzlib/build-aux/test-driver.scm000066400000000000000000000173031461353300200201440ustar00rootroot00000000000000 ;;;; test-driver.scm - Guile test driver for Automake testsuite harness (define script-version "2019-01-15.13") ;UTC ;;; Copyright © 2015, 2016 Mathieu Lirzin ;;; Copyright © 2019 Alex Sassmannshausen ;;; ;;; This program 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. ;;; ;;; This program 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 this program. If not, see . ;;;; Commentary: ;;; ;;; This script provides a Guile test driver using the SRFI-64 Scheme API for ;;; test suites. SRFI-64 is distributed with Guile since version 2.0.9. ;;; ;;; This script is a lightly modified version of the orignal written by ;;; Matthieu Lirzin. The changes make it suitable for use as part of the ;;; guile-hall infrastructure. ;;; ;;;; Code: (use-modules (ice-9 getopt-long) (ice-9 pretty-print) (srfi srfi-26) (srfi srfi-64)) (define (show-help) (display "Usage: test-driver --test-name=NAME --log-file=PATH --trs-file=PATH [--expect-failure={yes|no}] [--color-tests={yes|no}] [--enable-hard-errors={yes|no}] [--brief={yes|no}}] [--] TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS] The '--test-name', '--log-file' and '--trs-file' options are mandatory. ")) (define %options '((test-name (value #t)) (log-file (value #t)) (trs-file (value #t)) (color-tests (value #t)) (expect-failure (value #t)) ;XXX: not implemented yet (enable-hard-errors (value #t)) ;not implemented in SRFI-64 (brief (value #t)) (help (single-char #\h) (value #f)) (version (single-char #\V) (value #f)))) (define (option->boolean options key) "Return #t if the value associated with KEY in OPTIONS is 'yes'." (and=> (option-ref options key #f) (cut string=? <> "yes"))) (define* (test-display field value #:optional (port (current-output-port)) #:key pretty?) "Display 'FIELD: VALUE\n' on PORT." (if pretty? (begin (format port "~A:~%" field) (pretty-print value port #:per-line-prefix "+ ")) (format port "~A: ~S~%" field value))) (define* (result->string symbol #:key colorize?) "Return SYMBOL as an upper case string. Use colors when COLORIZE is #t." (let ((result (string-upcase (symbol->string symbol)))) (if colorize? (string-append (case symbol ((pass) "") ;green ((xfail) "") ;light green ((skip) "") ;blue ((fail xpass) "") ;red ((error) "")) ;magenta result "") ;no color result))) (define* (test-runner-gnu test-name #:key color? brief? out-port trs-port) "Return an custom SRFI-64 test runner. TEST-NAME is a string specifying the file name of the current the test. COLOR? specifies whether to use colors, and BRIEF?, well, you know. OUT-PORT and TRS-PORT must be output ports. The current output port is supposed to be redirected to a '.log' file." (define (test-on-test-begin-gnu runner) ;; Procedure called at the start of an individual test case, before the ;; test expression (and expected value) are evaluated. (let ((result (cute assq-ref (test-result-alist runner) <>))) (format #t "test-name: ~A~%" (result 'test-name)) (format #t "location: ~A~%" (string-append (result 'source-file) ":" (number->string (result 'source-line)))) (test-display "source" (result 'source-form) #:pretty? #t))) (define (test-on-test-end-gnu runner) ;; Procedure called at the end of an individual test case, when the result ;; of the test is available. (let* ((results (test-result-alist runner)) (result? (cut assq <> results)) (result (cut assq-ref results <>))) (unless brief? ;; Display the result of each test case on the console. (format out-port "~A: ~A - ~A~%" (result->string (test-result-kind runner) #:colorize? color?) test-name (test-runner-test-name runner))) (when (result? 'expected-value) (test-display "expected-value" (result 'expected-value))) (when (result? 'expected-error) (test-display "expected-error" (result 'expected-error) #:pretty? #t)) (when (result? 'actual-value) (test-display "actual-value" (result 'actual-value))) (when (result? 'actual-error) (test-display "actual-error" (result 'actual-error) #:pretty? #t)) (format #t "result: ~a~%" (result->string (result 'result-kind))) (newline) (format trs-port ":test-result: ~A ~A~%" (result->string (test-result-kind runner)) (test-runner-test-name runner)))) (define (test-on-group-end-gnu runner) ;; Procedure called by a 'test-end', including at the end of a test-group. (let ((fail (or (positive? (test-runner-fail-count runner)) (positive? (test-runner-xpass-count runner)))) (skip (or (positive? (test-runner-skip-count runner)) (positive? (test-runner-xfail-count runner))))) ;; XXX: The global results need some refinements for XPASS. (format trs-port ":global-test-result: ~A~%" (if fail "FAIL" (if skip "SKIP" "PASS"))) (format trs-port ":recheck: ~A~%" (if fail "yes" "no")) (format trs-port ":copy-in-global-log: ~A~%" (if (or fail skip) "yes" "no")) (when brief? ;; Display the global test group result on the console. (format out-port "~A: ~A~%" (result->string (if fail 'fail (if skip 'skip 'pass)) #:colorize? color?) test-name)) #f)) (let ((runner (test-runner-null))) (test-runner-on-test-begin! runner test-on-test-begin-gnu) (test-runner-on-test-end! runner test-on-test-end-gnu) (test-runner-on-group-end! runner test-on-group-end-gnu) (test-runner-on-bad-end-name! runner test-on-bad-end-name-simple) runner)) ;;; ;;; Entry point. ;;; (define (main . args) (let* ((opts (getopt-long (command-line) %options)) (option (cut option-ref opts <> <>))) (cond ((option 'help #f) (show-help)) ((option 'version #f) (format #t "test-driver.scm ~A" script-version)) (else (let ((log (open-file (option 'log-file "") "w0")) (trs (open-file (option 'trs-file "") "wl")) (out (duplicate-port (current-output-port) "wl"))) (redirect-port log (current-output-port)) (redirect-port log (current-warning-port)) (redirect-port log (current-error-port)) (test-with-runner (test-runner-gnu (option 'test-name #f) #:color? (option->boolean opts 'color-tests) #:brief? (option->boolean opts 'brief) #:out-port out #:trs-port trs) (load-from-path (option 'test-name #f))) (close-port log) (close-port trs) (close-port out)))) (exit 0))) guile-lzlib/configure.ac000066400000000000000000000044151461353300200155640ustar00rootroot00000000000000AC_INIT(guile-lzlib, 0.3.0) AC_SUBST(HVERSION, "\"0.3.0\"") AC_SUBST(AUTHOR, "\"Mathieu Othacehe\"") AC_SUBST(COPYRIGHT, "'(2020)") AC_SUBST(LICENSE, gpl3+) AC_CONFIG_SRCDIR(lzlib.scm) AC_CONFIG_AUX_DIR([build-aux]) AM_INIT_AUTOMAKE([1.12 gnu silent-rules subdir-objects color-tests parallel-tests -Woverride -Wno-portability]) AM_SILENT_RULES([yes]) AC_CONFIG_FILES([Makefile lzlib/config.scm]) AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) dnl Search for 'guile' and 'guild'. This macro defines dnl 'GUILE_EFFECTIVE_VERSION'. GUILE_PKG([3.0 2.2 2.0]) GUILE_PROGS GUILE_SITE_DIR if test "x$GUILD" = "x"; then AC_MSG_ERROR(['guild' binary not found; please check your GNU Guile installation.]) fi if test "$cross_compiling" != no; then GUILE_TARGET="--target=$host_alias" AC_SUBST([GUILE_TARGET]) fi AC_DEFUN([GUILE_LIBLZ_FILE_NAME], [ AC_REQUIRE([PKG_PROG_PKG_CONFIG]) AC_CACHE_CHECK([lzlib's file name], [guile_cv_liblz_libdir], [if test "$cross_compiling" = yes; then # When cross-compiling, we cannot rely on 'ldd'. Instead, look # the output of 'ld --verbose', assuming we're using GNU ld. echo 'int main () { return LZ_decompress_open(); }' > conftest.c guile_cv_liblz_libdir="\ `$CC conftest.c -o conftest$EXEEXT -llz -Wl,--verbose 2>/dev/null \ | grep -E '^/.*/liblz\.(a|so)'`" rm -f conftest.c conftest$EXEEXT else old_LIBS="$LIBS" LIBS="-llz" AC_LINK_IFELSE([AC_LANG_SOURCE([int main () { return LZ_decompress_open(); }])], [guile_cv_liblz_libdir="`ldd conftest$EXEEXT | grep liblz | sed '-es/.*=> \(.*\) .*$/\1/g'`"]) LIBS="$old_LIBS" fi]) $1="$guile_cv_liblz_libdir" ]) dnl Library name of lzlib suitable for 'dynamic-link'. GUILE_LIBLZ_FILE_NAME([LIBLZ_LIBDIR]) if test "x$LIBLZ_LIBDIR" = "x"; then LIBLZ_LIBDIR="liblz" else # Strip the .so or .so.1 extension since that's what 'dynamic-link' expects. LIBLZ_LIBDIR="`echo $LIBLZ_LIBDIR | sed -es'/\.so\(\.[[0-9.]]\+\)\?//g'`" fi AC_SUBST([LIBLZ_LIBDIR]) dnl Installation directories for .scm and .go files. guilemoduledir="${datarootdir}/guile/site/$GUILE_EFFECTIVE_VERSION" guileobjectdir="${libdir}/guile/$GUILE_EFFECTIVE_VERSION/site-ccache" AC_SUBST([guilemoduledir]) AC_SUBST([guileobjectdir]) AC_OUTPUT guile-lzlib/guix.scm000066400000000000000000000013121461353300200147470ustar00rootroot00000000000000(use-modules (guix packages) ((guix licenses) #:prefix license:) (guix download) (guix build-system gnu) (gnu packages) (gnu packages autotools) (gnu packages compression) (gnu packages guile) (gnu packages guile-xyz) (gnu packages pkg-config) (gnu packages texinfo)) (package (name "guile-lzlib") (version "0.3.0") (source "./guile-lzlib-0.3.0.tar.gz") (build-system gnu-build-system) (arguments `()) (native-inputs `(("autoconf" ,autoconf) ("automake" ,automake) ("pkg-config" ,pkg-config))) (inputs `(("guile" ,guile-3.0) ("lzlib" ,lzlib))) (propagated-inputs `()) (synopsis "") (description "") (home-page "") (license license:gpl3+)) guile-lzlib/hall.scm000066400000000000000000000017371461353300200147260ustar00rootroot00000000000000(hall-description (name "lzlib") (prefix "guile") (version "0.3.0") (author "Mathieu Othacehe") (copyright (2020)) (synopsis "") (description "") (home-page "") (license gpl3+) (dependencies `()) (files (libraries ((scheme-file "lzlib") (directory "lzlib" ((scheme-file "config"))))) (tests ((directory "tests" ((scheme-file "lzlib"))))) (programs ()) (documentation ((org-file "README") (symlink "README" "README.org") (text-file "HACKING") (text-file "COPYING") (text-file "NEWS") (text-file "AUTHORS") (text-file "ChangeLog"))) (infrastructure ((scheme-file "guix") (scheme-file "hall") (directory "build-aux" ((scheme-file "test-driver"))) (autoconf-file "configure") (automake-file "Makefile") (in-file "pre-inst-env"))))) guile-lzlib/lzlib.scm000066400000000000000000000714131461353300200151200ustar00rootroot00000000000000;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Pierre Neidhardt ;;; Copyright © 2019-2020, 2024 Ludovic Courtès ;;; Copyright © 2020 Mathieu Othacehe ;;; ;;; 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 . (define-module (lzlib) #:use-module (lzlib config) #:use-module (rnrs bytevectors) #:use-module (rnrs arithmetic bitwise) #:use-module (ice-9 binary-ports) #:use-module (ice-9 match) #:use-module (system foreign) #:use-module (srfi srfi-11) #:export (make-lzip-input-port make-lzip-output-port make-lzip-input-port/compressed call-with-lzip-input-port call-with-lzip-output-port %default-member-length-limit %default-compression-level dictionary-size+match-length-limit)) ;;; Commentary: ;;; ;;; This file is extracted from Guix and originally written by Pierre Neidhardt ;;; and Ludovic Courtès. ;;; ;;; Bindings to the lzlib / liblz API. Some convenience functions are also ;;; provided (see the export). ;;; ;;; While the bindings are complete, the convenience functions only support ;;; single member archives. To decompress single member archives, we loop ;;; until lz-decompress-read returns 0. This is simpler. To support multiple ;;; members properly, we need (among others) to call lz-decompress-finish and ;;; loop over lz-decompress-read until lz-decompress-finished? returns #t. ;;; Otherwise a multi-member archive starting with an empty member would only ;;; decompress the empty member and stop there, resulting in truncated output. ;;; Code: (define %liblz-handle (delay (dynamic-link %liblz))) (define register-allocation ;; Let the GC know that an unmanaged heap allocation took place. (pointer->procedure void (dynamic-func "scm_gc_register_allocation" (dynamic-link)) (list size_t))) (define (lzlib-procedure ret name parameters) "Return a procedure corresponding to C function NAME in liblz, or #f if either lzlib or the function could not be found." (match (false-if-exception (dynamic-func name (force %liblz-handle))) ((? pointer? ptr) (pointer->procedure ret ptr parameters)) (#f #f))) (define-wrapped-pointer-type ;; Scheme counterpart of the 'LZ_Decoder' opaque type. lz-decoder? pointer->lz-decoder lz-decoder->pointer (lambda (obj port) (format port "#" (number->string (object-address obj) 16)))) (define-wrapped-pointer-type ;; Scheme counterpart of the 'LZ_Encoder' opaque type. lz-encoder? pointer->lz-encoder lz-encoder->pointer (lambda (obj port) (format port "#" (number->string (object-address obj) 16)))) ;; From lzlib.h (define %error-number-ok 0) (define %error-number-bad-argument 1) (define %error-number-mem-error 2) (define %error-number-sequence-error 3) (define %error-number-header-error 4) (define %error-number-unexpected-eof 5) (define %error-number-data-error 6) (define %error-number-library-error 7) ;; Compression bindings. (define %lz-compress-close (delay (dynamic-func "LZ_compress_close" (force %liblz-handle)))) (define lz-compress-open (let ((proc (lzlib-procedure '* "LZ_compress_open" (list int int uint64))) ;; member-size is an "unsigned long long", and the C standard guarantees ;; a minimum range of 0..2^64-1. (unlimited-size (- (expt 2 64) 1))) (lambda* (dictionary-size match-length-limit #:optional (member-size unlimited-size)) "Initialize the internal stream state for compression and returns a pointer that can only be used as the encoder argument for the other lz-compress functions, or a null pointer if the encoder could not be allocated. See the manual: (lzlib) Compression functions." (let ((encoder-ptr (proc dictionary-size match-length-limit member-size))) (if (not (= (lz-compress-error encoder-ptr) -1)) (begin ;; Since the allocation behind the encoder may be large, notify ;; the GC so it can be triggered more quickly. (register-allocation (* 2 dictionary-size)) ;; Register a finalizer for the encoder. The other option ;; would be to call 'LZ_compress_close' explicitly from the ;; 'close' method of the output port but that doesn't work ;; because the 'close' method is not called when the port is ;; GC'd. Furthermore, 'LZ_compress_close' can only be called ;; once, so we can't do both. (set-pointer-finalizer! encoder-ptr (force %lz-compress-close)) (pointer->lz-encoder encoder-ptr)) (throw 'lzlib-error 'lz-compress-open)))))) (define lz-compress-finish (let ((proc (lzlib-procedure int "LZ_compress_finish" '(*)))) (lambda (encoder) "Tell that all the data for this member have already been written (with the `lz-compress-write' function). It is safe to call `lz-compress-finish' as many times as needed. After all the produced compressed data have been read with `lz-compress-read' and `lz-compress-member-finished?' returns #t, a new member can be started with 'lz-compress-restart-member'." (let ((ret (proc (lz-encoder->pointer encoder)))) (if (= ret -1) (throw 'lzlib-error 'lz-compress-finish (lz-compress-error encoder)) ret))))) (define lz-compress-restart-member (let ((proc (lzlib-procedure int "LZ_compress_restart_member" (list '* uint64)))) (lambda (encoder member-size) "Start a new member in a multimember data stream. Call this function only after `lz-compress-member-finished?' indicates that the current member has been fully read (with the `lz-compress-read' function)." (let ((ret (proc (lz-encoder->pointer encoder) member-size))) (if (= ret -1) (throw 'lzlib-error 'lz-compress-restart-member (lz-compress-error encoder)) ret))))) (define lz-compress-sync-flush (let ((proc (lzlib-procedure int "LZ_compress_sync_flush" (list '*)))) (lambda (encoder) "Make available to `lz-compress-read' all the data already written with the `LZ-compress-write' function. First call `lz-compress-sync-flush'. Then call 'lz-compress-read' until it returns 0. Repeated use of `LZ-compress-sync-flush' may degrade compression ratio, so use it only when needed. " (let ((ret (proc (lz-encoder->pointer encoder)))) (if (= ret -1) (throw 'lzlib-error 'lz-compress-sync-flush (lz-compress-error encoder)) ret))))) (define lz-compress-read (let ((proc (lzlib-procedure int "LZ_compress_read" (list '* '* int)))) (lambda* (encoder lzfile-bv #:optional (start 0) (count (bytevector-length lzfile-bv))) "Read up to COUNT bytes from the encoder stream, storing the results in LZFILE-BV. Return the number of uncompressed bytes written, a positive integer." (let ((ret (proc (lz-encoder->pointer encoder) (bytevector->pointer lzfile-bv start) count))) (if (= ret -1) (throw 'lzlib-error 'lz-compress-read (lz-compress-error encoder)) ret))))) (define lz-compress-write (let ((proc (lzlib-procedure int "LZ_compress_write" (list '* '* int)))) (lambda* (encoder bv #:optional (start 0) (count (bytevector-length bv))) "Write up to COUNT bytes from BV to the encoder stream. Return the number of uncompressed bytes written, a strictly positive integer." (let ((ret (proc (lz-encoder->pointer encoder) (bytevector->pointer bv start) count))) (if (< ret 0) (throw 'lzlib-error 'lz-compress-write (lz-compress-error encoder)) ret))))) (define lz-compress-write-size (let ((proc (lzlib-procedure int "LZ_compress_write_size" '(*)))) (lambda (encoder) "The maximum number of bytes that can be immediately written through the `lz-compress-write' function. It is guaranteed that an immediate call to `lz-compress-write' will accept a SIZE up to the returned number of bytes. " (let ((ret (proc (lz-encoder->pointer encoder)))) (if (= ret -1) (throw 'lzlib-error 'lz-compress-write-size (lz-compress-error encoder)) ret))))) (define lz-compress-error (let ((proc (lzlib-procedure int "LZ_compress_errno" '(*)))) (lambda (encoder) "ENCODER can be a Scheme object or a pointer." (let* ((error-number (proc (if (lz-encoder? encoder) (lz-encoder->pointer encoder) encoder)))) error-number)))) (define lz-compress-finished? (let ((proc (lzlib-procedure int "LZ_compress_finished" '(*)))) (lambda (encoder) "Return #t if all the data have been read, otherwise return #f." (let ((ret (proc (lz-encoder->pointer encoder)))) (match ret (1 #t) (0 #f) (_ (throw 'lzlib-error 'lz-compress-finished? (lz-compress-error encoder)))))))) (define lz-compress-member-finished? (let ((proc (lzlib-procedure int "LZ_compress_member_finished" '(*)))) (lambda (encoder) "Return #t if the current member, in a multimember data stream, has been fully read and 'lz-compress-restart-member' can be safely called. Otherwise return #f." (let ((ret (proc (lz-encoder->pointer encoder)))) (match ret (1 #t) (0 #f) (_ (throw 'lzlib-error 'lz-compress-member-finished? (lz-compress-error encoder)))))))) (define lz-compress-data-position (let ((proc (lzlib-procedure uint64 "LZ_compress_data_position" '(*)))) (lambda (encoder) "Return the number of input bytes already compressed in the current member." (let ((ret (proc (lz-encoder->pointer encoder)))) (if (= ret -1) (throw 'lzlib-error 'lz-compress-data-position (lz-compress-error encoder)) ret))))) (define lz-compress-member-position (let ((proc (lzlib-procedure uint64 "LZ_compress_member_position" '(*)))) (lambda (encoder) "Return the number of compressed bytes already produced, but perhaps not yet read, in the current member." (let ((ret (proc (lz-encoder->pointer encoder)))) (if (= ret -1) (throw 'lzlib-error 'lz-compress-member-position (lz-compress-error encoder)) ret))))) (define lz-compress-total-in-size (let ((proc (lzlib-procedure uint64 "LZ_compress_total_in_size" '(*)))) (lambda (encoder) "Return the total number of input bytes already compressed." (let ((ret (proc (lz-encoder->pointer encoder)))) (if (= ret -1) (throw 'lzlib-error 'lz-compress-total-in-size (lz-compress-error encoder)) ret))))) (define lz-compress-total-out-size (let ((proc (lzlib-procedure uint64 "LZ_compress_total_out_size" '(*)))) (lambda (encoder) "Return the total number of compressed bytes already produced, but perhaps not yet read." (let ((ret (proc (lz-encoder->pointer encoder)))) (if (= ret -1) (throw 'lzlib-error 'lz-compress-total-out-size (lz-compress-error encoder)) ret))))) ;; Decompression bindings. (define %lz-decompress-close (delay (dynamic-func "LZ_decompress_close" (force %liblz-handle)))) (define lz-decompress-open (let ((proc (lzlib-procedure '* "LZ_decompress_open" '()))) (lambda () "Initializes the internal stream state for decompression and returns a pointer that can only be used as the decoder argument for the other lz-decompress functions, or a null pointer if the decoder could not be allocated. See the manual: (lzlib) Decompression functions." (let ((decoder-ptr (proc))) (if (not (= (lz-decompress-error decoder-ptr) -1)) (begin (register-allocation (expt 2 16)) ;XXX: rough estimate (set-pointer-finalizer! decoder-ptr (force %lz-decompress-close)) (pointer->lz-decoder decoder-ptr)) (throw 'lzlib-error 'lz-decompress-open)))))) (define lz-decompress-finish (let ((proc (lzlib-procedure int "LZ_decompress_finish" '(*)))) (lambda (decoder) "Tell that all the data for this stream have already been written (with the `lz-decompress-write' function). It is safe to call `lz-decompress-finish' as many times as needed." (let ((ret (proc (lz-decoder->pointer decoder)))) (if (= ret -1) (throw 'lzlib-error 'lz-decompress-finish (lz-decompress-error decoder)) ret))))) (define lz-decompress-reset (let ((proc (lzlib-procedure int "LZ_decompress_reset" '(*)))) (lambda (decoder) "Reset the internal state of DECODER as it was just after opening it with the `lz-decompress-open' function. Data stored in the internal buffers is discarded. Position counters are set to 0." (let ((ret (proc (lz-decoder->pointer decoder)))) (if (= ret -1) (throw 'lzlib-error 'lz-decompress-reset (lz-decompress-error decoder)) ret))))) (define lz-decompress-sync-to-member (let ((proc (lzlib-procedure int "LZ_decompress_sync_to_member" '(*)))) (lambda (decoder) "Reset the error state of DECODER and enters a search state that lasts until a new member header (or the end of the stream) is found. After a successful call to `lz-decompress-sync-to-member', data written with `lz-decompress-write' will be consumed and 'lz-decompress-read' will return 0 until a header is found. This function is useful to discard any data preceding the first member, or to discard the rest of the current member, for example in case of a data error. If the decoder is already at the beginning of a member, this function does nothing." (let ((ret (proc (lz-decoder->pointer decoder)))) (if (= ret -1) (throw 'lzlib-error 'lz-decompress-sync-to-member (lz-decompress-error decoder)) ret))))) (define lz-decompress-read (let ((proc (lzlib-procedure int "LZ_decompress_read" (list '* '* int)))) (lambda* (decoder file-bv #:optional (start 0) (count (bytevector-length file-bv))) "Read up to COUNT bytes from the decoder stream, storing the results in FILE-BV. Return the number of uncompressed bytes written, a non-negative positive integer." (let ((ret (proc (lz-decoder->pointer decoder) (bytevector->pointer file-bv start) count))) (if (< ret 0) (throw 'lzlib-error 'lz-decompress-read (lz-decompress-error decoder)) ret))))) (define lz-decompress-write (let ((proc (lzlib-procedure int "LZ_decompress_write" (list '* '* int)))) (lambda* (decoder bv #:optional (start 0) (count (bytevector-length bv))) "Write up to COUNT bytes from BV to the decoder stream. Return the number of uncompressed bytes written, a non-negative integer." (let ((ret (proc (lz-decoder->pointer decoder) (bytevector->pointer bv start) count))) (if (< ret 0) (throw 'lzlib-error 'lz-decompress-write (lz-decompress-error decoder)) ret))))) (define lz-decompress-write-size (let ((proc (lzlib-procedure int "LZ_decompress_write_size" '(*)))) (lambda (decoder) "Return the maximum number of bytes that can be immediately written through the `lz-decompress-write' function. It is guaranteed that an immediate call to `lz-decompress-write' will accept a SIZE up to the returned number of bytes. " (let ((ret (proc (lz-decoder->pointer decoder)))) (if (= ret -1) (throw 'lzlib-error 'lz-decompress-write-size (lz-decompress-error decoder)) ret))))) (define lz-decompress-error (let ((proc (lzlib-procedure int "LZ_decompress_errno" '(*)))) (lambda (decoder) "DECODER can be a Scheme object or a pointer." (let* ((error-number (proc (if (lz-decoder? decoder) (lz-decoder->pointer decoder) decoder)))) error-number)))) (define lz-decompress-finished? (let ((proc (lzlib-procedure int "LZ_decompress_finished" '(*)))) (lambda (decoder) "Return #t if all the data have been read, otherwise return #f." (let ((ret (proc (lz-decoder->pointer decoder)))) (match ret (1 #t) (0 #f) (_ (throw 'lzlib-error 'lz-decompress-finished? (lz-decompress-error decoder)))))))) (define lz-decompress-member-finished? (let ((proc (lzlib-procedure int "LZ_decompress_member_finished" '(*)))) (lambda (decoder) "Return #t if the current member, in a multimember data stream, has been fully read and `lz-decompress-restart-member' can be safely called. Otherwise return #f." (let ((ret (proc (lz-decoder->pointer decoder)))) (match ret (1 #t) (0 #f) (_ (throw 'lzlib-error 'lz-decompress-member-finished? (lz-decompress-error decoder)))))))) (define lz-decompress-member-version (let ((proc (lzlib-procedure int "LZ_decompress_member_version" '(*)))) (lambda (decoder) (let ((ret (proc (lz-decoder->pointer decoder)))) "Return the version of current member from member header." (if (= ret -1) (throw 'lzlib-error 'lz-decompress-data-position (lz-decompress-error decoder)) ret))))) (define lz-decompress-dictionary-size (let ((proc (lzlib-procedure int "LZ_decompress_dictionary_size" '(*)))) (lambda (decoder) (let ((ret (proc (lz-decoder->pointer decoder)))) "Return the dictionary size of current member from member header." (if (= ret -1) (throw 'lzlib-error 'lz-decompress-member-position (lz-decompress-error decoder)) ret))))) (define lz-decompress-data-crc (let ((proc (lzlib-procedure unsigned-int "LZ_decompress_data_crc" '(*)))) (lambda (decoder) (let ((ret (proc (lz-decoder->pointer decoder)))) "Return the 32 bit Cyclic Redundancy Check of the data decompressed from the current member. The returned value is valid only when `lz-decompress-member-finished' returns #t. " (if (= ret -1) (throw 'lzlib-error 'lz-decompress-member-position (lz-decompress-error decoder)) ret))))) (define lz-decompress-data-position (let ((proc (lzlib-procedure uint64 "LZ_decompress_data_position" '(*)))) (lambda (decoder) "Return the number of decompressed bytes already produced, but perhaps not yet read, in the current member." (let ((ret (proc (lz-decoder->pointer decoder)))) (if (= ret -1) (throw 'lzlib-error 'lz-decompress-data-position (lz-decompress-error decoder)) ret))))) (define lz-decompress-member-position (let ((proc (lzlib-procedure uint64 "LZ_decompress_member_position" '(*)))) (lambda (decoder) "Return the number of input bytes already decompressed in the current member." (let ((ret (proc (lz-decoder->pointer decoder)))) (if (= ret -1) (throw 'lzlib-error 'lz-decompress-member-position (lz-decompress-error decoder)) ret))))) (define lz-decompress-total-in-size (let ((proc (lzlib-procedure uint64 "LZ_decompress_total_in_size" '(*)))) (lambda (decoder) (let ((ret (proc (lz-decoder->pointer decoder)))) "Return the total number of input bytes already compressed." (if (= ret -1) (throw 'lzlib-error 'lz-decompress-total-in-size (lz-decompress-error decoder)) ret))))) (define lz-decompress-total-out-size (let ((proc (lzlib-procedure uint64 "LZ_decompress_total_out_size" '(*)))) (lambda (decoder) (let ((ret (proc (lz-decoder->pointer decoder)))) "Return the total number of compressed bytes already produced, but perhaps not yet read." (if (= ret -1) (throw 'lzlib-error 'lz-decompress-total-out-size (lz-decompress-error decoder)) ret))))) ;; High level functions. (define* (lzread! decoder port bv #:optional (start 0) (count (bytevector-length bv))) "Read up to COUNT bytes from PORT into BV at offset START. Return the number of uncompressed bytes actually read; it is zero if COUNT is zero or if the end-of-stream has been reached." (define (feed-decoder! decoder) ;; Feed DECODER with data read from PORT. (match (get-bytevector-n port (lz-decompress-write-size decoder)) ((? eof-object? eof) eof) (bv (lz-decompress-write decoder bv)))) (let loop ((read 0) (start start)) (cond ((< read count) (match (lz-decompress-read decoder bv start (- count read)) (0 (cond ((lz-decompress-finished? decoder) read) ((eof-object? (feed-decoder! decoder)) (lz-decompress-finish decoder) (loop read start)) (else ;read again (loop read start)))) (n (loop (+ read n) (+ start n))))) (else read)))) (define (lzwrite! encoder source source-offset source-count target target-offset target-count) "Write up to SOURCE-COUNT bytes from SOURCE to ENCODER, and read up to TARGET-COUNT bytes into TARGET at TARGET-OFFSET. Return two values: the number of bytes read from SOURCE, and the number of bytes written to TARGET, possibly zero." (define read (if (> (lz-compress-write-size encoder) 0) (match (lz-compress-write encoder source source-offset source-count) (0 (lz-compress-finish encoder) 0) (n n)) 0)) (define written (lz-compress-read encoder target target-offset target-count)) (values read written)) (define* (lzwrite encoder bv lz-port #:optional (start 0) (count (bytevector-length bv))) "Write up to COUNT bytes from BV at offset START into LZ-PORT. Return the number of uncompressed bytes written, a non-negative integer." (let ((written 0) (read 0)) (while (and (< 0 (lz-compress-write-size encoder)) (< written count)) (set! written (+ written (lz-compress-write encoder bv (+ start written) (- count written))))) (when (= written 0) (lz-compress-finish encoder)) (let ((lz-bv (make-bytevector written))) (let loop ((rd 0)) (set! rd (lz-compress-read encoder lz-bv 0 (bytevector-length lz-bv))) (put-bytevector lz-port lz-bv 0 rd) (set! read (+ read rd)) (unless (= rd 0) (loop rd)))) ;; `written' is the total byte count of uncompressed data. written)) ;;; ;;; Port interface. ;;; ;; Alist of (levels (dictionary-size match-length-limit)). 0 is the fastest. ;; See bbexample.c in lzlib's source. (define %compression-levels `((0 65535 16) (1 ,(bitwise-arithmetic-shift-left 1 20) 5) (2 ,(bitwise-arithmetic-shift-left 3 19) 6) (3 ,(bitwise-arithmetic-shift-left 1 21) 8) (4 ,(bitwise-arithmetic-shift-left 3 20) 12) (5 ,(bitwise-arithmetic-shift-left 1 22) 20) (6 ,(bitwise-arithmetic-shift-left 1 23) 36) (7 ,(bitwise-arithmetic-shift-left 1 24) 68) (8 ,(bitwise-arithmetic-shift-left 3 23) 132) (9 ,(bitwise-arithmetic-shift-left 1 25) 273))) (define %default-compression-level 6) (define (dictionary-size+match-length-limit level) "Return two values: the dictionary size for LEVEL, and its match-length limit. LEVEL must be a compression level, an integer between 0 and 9." (match (assv-ref %compression-levels level) ((dictionary-size match-length-limit) (values dictionary-size match-length-limit)))) (define* (make-lzip-input-port port) "Return an input port that decompresses data read from PORT, a file port. PORT is automatically closed when the resulting port is closed." (define decoder (lz-decompress-open)) (define (read! bv start count) (lzread! decoder port bv start count)) (make-custom-binary-input-port "lzip-input" read! #f #f (lambda () ;; DECODER will be freed by its pointer ;; finalizer. (close-port port)))) (define* (make-lzip-output-port port #:key (level %default-compression-level)) "Return an output port that compresses data at the given LEVEL, using PORT, a file port, as its sink. PORT is automatically closed when the resulting port is closed." (define encoder (call-with-values (lambda () (dictionary-size+match-length-limit level)) lz-compress-open)) (define (write! bv start count) (lzwrite encoder bv port start count)) (make-custom-binary-output-port "lzip-output" write! #f #f (lambda () (lz-compress-finish encoder) ;; "lz-read" the trailing metadata added by `lz-compress-finish'. (let ((lz-bv (make-bytevector (* 64 1024)))) (let loop ((rd 0)) (set! rd (lz-compress-read encoder lz-bv 0 (bytevector-length lz-bv))) (put-bytevector port lz-bv 0 rd) (unless (= rd 0) (loop rd)))) ;; ENCODER will be freed by its pointer ;; finalizer. (close-port port)))) (define* (make-lzip-input-port/compressed port #:key (level %default-compression-level)) "Return an input port that compresses data read from PORT, with the given LEVEL. PORT is automatically closed when the resulting port is closed." (define encoder (call-with-values (lambda () (dictionary-size+match-length-limit level)) lz-compress-open)) (define input-buffer (make-bytevector 8192)) (define input-len 0) (define input-offset 0) (define input-eof? #f) (define (read! bv start count) (cond (input-eof? (match (lz-compress-read encoder bv start count) (0 (if (lz-compress-finished? encoder) 0 (read! bv start count))) (n n))) ((= input-offset input-len) (match (get-bytevector-n! port input-buffer 0 (bytevector-length input-buffer)) ((? eof-object?) (set! input-eof? #t) (lz-compress-finish encoder)) (count (set! input-offset 0) (set! input-len count))) (read! bv start count)) (else (let-values (((read written) (lzwrite! encoder input-buffer input-offset (- input-len input-offset) bv start count))) (set! input-offset (+ input-offset read)) ;; Make sure we don't return zero except on EOF. (if (= 0 written) (read! bv start count) written))))) (make-custom-binary-input-port "lzip-input/compressed" read! #f #f (lambda () (close-port port)))) (define* (call-with-lzip-input-port port proc) "Call PROC with a port that wraps PORT and decompresses data read from it. PORT is closed upon completion." (let ((lzip (make-lzip-input-port port))) (dynamic-wind (const #t) (lambda () (proc lzip)) (lambda () (close-port lzip))))) (define* (call-with-lzip-output-port port proc #:key (level %default-compression-level)) "Call PROC with an output port that wraps PORT and compresses data. PORT is close upon completion." (let ((lzip (make-lzip-output-port port #:level level))) (dynamic-wind (const #t) (lambda () (proc lzip)) (lambda () (close-port lzip))))) ;;; lzlib.scm ends here guile-lzlib/lzlib/000077500000000000000000000000001461353300200144065ustar00rootroot00000000000000guile-lzlib/lzlib/config.scm.in000066400000000000000000000015771461353300200167760ustar00rootroot00000000000000;;; Guile-lzlib --- GNU Guile bindings of lzlib ;;; Copyright © 2020 Mathieu Othacehe ;;; ;;; This file is part of Guile-lzlib. ;;; ;;; Guile-lzlib 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. ;;; ;;; Guile-lzlib 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 Guile-lzlib. If not, see . (define-module (lzlib config) #:export (%liblz)) (define %liblz "@LIBLZ_LIBDIR@") guile-lzlib/pre-inst-env.in000066400000000000000000000006621461353300200161550ustar00rootroot00000000000000 #!/bin/sh abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`" abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`" GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH" GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH" export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH PATH="$abs_top_builddir/scripts:$PATH" export PATH exec "$@" guile-lzlib/tests/000077500000000000000000000000001461353300200144345ustar00rootroot00000000000000guile-lzlib/tests/lzlib.scm000066400000000000000000000117561461353300200162660ustar00rootroot00000000000000;;; Guile-lzlib --- Functional package management for GNU ;;; Copyright © 2019 Pierre Neidhardt ;;; Copyright © 2020 Mathieu Othacehe ;;; ;;; This file is part of Guile-lzlib. ;;; ;;; Guile-lzlib 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. ;;; ;;; Guile-lzlib 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 Guile-lzlib. If not, see . (define-module (test-lzlib) #:use-module (lzlib) #:use-module (srfi srfi-64) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (ice-9 match)) (test-begin "lzlib") (define (random-seed) (logxor (getpid) (car (gettimeofday)))) (define %seed (let ((seed (random-seed))) (format (current-error-port) "random seed for tests: ~a~%" seed) (seed->random-state seed))) (define (random-bytevector n) "Return a random bytevector of N bytes." (let ((bv (make-bytevector n))) (let loop ((i 0)) (if (< i n) (begin (bytevector-u8-set! bv i (random 256 %seed)) (loop (1+ i))) bv)))) (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)