;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-lzlib)
  #:use-module (guix lzlib)
  #:use-module (guix tests)
  #:use-module (srfi srfi-64)
  #:use-module (rnrs bytevectors)
  #:use-module (rnrs io ports)
  #:use-module (ice-9 match))

;; Test the (guix lzlib) module.

(define-syntax-rule (test-assert* description exp)
  (begin
    (unless (lzlib-available?)
      (test-skip 1))
    (test-assert description exp)))

(test-begin "lzlib")

(define (compress-and-decompress data)
  "DATA must be a bytevector."
  (pk "Uncompressed bytes:" (bytevector-length data))
  (match (pipe)
    ((parent . child)
     (match (primitive-fork)
       (0                               ;compress
        (dynamic-wind
          (const #t)
          (lambda ()
            (close-port parent)
            (call-with-lzip-output-port child
              (lambda (port)
                (put-bytevector port data))))
          (lambda ()
            (primitive-exit 0))))
       (pid                             ;decompress
        (begin
          (close-port child)
          (let ((received (call-with-lzip-input-port parent
                            (lambda (port)
                              (get-bytevector-all port)))))
            (match (waitpid pid)
              ((_ . status)
               (pk "Status" status)
               (pk "Length data" (bytevector-length data) "received" (bytevector-length received))
               ;; The following loop is a debug helper.
               (let loop ((i 0))
                 (if (and (< i (bytevector-length received))
                          (= (bytevector-u8-ref received i)
                             (bytevector-u8-ref data i)))
                     (loop (+ 1 i))
                     (pk "First diff at index" i)))
               (and (zero? status)
                    (port-closed? parent)
                    (bytevector=? received data)))))))))))

(test-assert* "null bytevector"
  (compress-and-decompress (make-bytevector (+ (random 100000)
                                               (* 20 1024)))))

(test-assert* "random bytevector"
  (compress-and-decompress (random-bytevector (+ (random 100000)
                                                 (* 20 1024)))))
(test-assert* "small bytevector"
  (compress-and-decompress (random-bytevector 127)))

(test-assert* "1 bytevector"
  (compress-and-decompress (random-bytevector 1)))

(test-assert* "Bytevector of size relative to Lzip internal buffers (2 * dictionary)"
  (compress-and-decompress
   (random-bytevector
    (* 2 (car (car (assoc-ref (@@ (guix lzlib) %compression-levels)
                              (@@ (guix lzlib) %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)
eld...
[diff-lines]: ...to this.
[definition?]: New field.
(hunk-&gt;patch): Join diff lines.
(diff-info): Do not join diff lines; record whether a hunk is a new
definition.
(commit-message): Rename this procedure...
(change-commit-message): ...to this.
(add-commit-message): New procedure.
(main): Handle new package definitions before changes.
</span></span></td><td>Ricardo Wurmus</td></tr>
<tr><td><span title='2020-10-06 00:34:59 +0200'>2020-10-06</span></td><td><a href='/guix/commit/etc/committer.scm.in?id=59fe30a3a860212ede0cd3c97e58a5f6bca8b65b'>etc: committer: Use EQUAL? instead of EQ? for differences.</a><span class='msg-avail'>...<span class='msg-tooltip'>* etc/committer.scm.in (commit-message): Use EQUAL? instead of EQ? to compute
differences because not all inputs may be symbols; some could be expressions.
</span></span></td><td>Ricardo Wurmus</td></tr>
<tr><td><span title='2020-06-16 11:32:53 +0200'>2020-06-16</span></td><td><a href='/guix/commit/etc/committer.scm.in?id=76a841cc8bd091db741758ae5553c714f2c38543'>etc: Add committer script.</a><span class='msg-avail'>...<span class='msg-tooltip'>* etc/committer.scm.in: New file.
* configure.ac: Configure it.
</span></span></td><td>Ricardo Wurmus</td></tr>