File: zstd.scm

package info (click to toggle)
guile-zstd 0.1.1-6
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 156 kB
  • sloc: lisp: 466; makefile: 40; sh: 8
file content (135 lines) | stat: -rw-r--r-- 4,941 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
;;; Guile-zstd --- GNU Guile bindings to the zstd compression library.
;;; Copyright © 2019 Pierre Neidhardt <mail@ambrevar.xyz>
;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of Guile-zstd.
;;;
;;; Guile-zstd 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-zstd 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-zstd.  If not, see <http://www.gnu.org/licenses/>.

(define-module (test-zstd)
  #:use-module (zstd)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-64)
  #:use-module (rnrs bytevectors)
  #:use-module (rnrs io ports)
  #:use-module (ice-9 match))

(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* (compressed-data data #:key (level %default-compression-level))
  (let-values (((port get) (open-bytevector-output-port)))
    (call-with-zstd-output-port port
      (lambda (port)
        (put-bytevector port data)))
    (get)))

(define* (compress-and-decompress data
                                  #:key (level %default-compression-level))
  (bytevector=? (let ((compressed (compressed-data data #:level level)))
                  (call-with-zstd-input-port
                      (open-bytevector-input-port compressed)
                    (lambda (port)
                      (match (get-bytevector-all port)
                        ((? eof-object?) #vu8())
                        (bv bv)))))
                data))

(define stream-compression-input-size
  (@@ (zstd) stream-compression-input-size))


(test-begin "zstd")

(test-assert "empty bytevector"
  (compress-and-decompress #vu8()))

(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 "one byte"
  (compress-and-decompress (random-bytevector 1)))

(test-assert "bytevector of size equal to Zstd internal buffers"
  (compress-and-decompress (random-bytevector (stream-compression-input-size))))

(test-assert "bytevector of size equal to Zstd internal buffers -1"
  (compress-and-decompress (random-bytevector (1- (stream-compression-input-size)))))

(test-assert "bytevector of size relative to Zstd internal buffers +1"
  (compress-and-decompress (random-bytevector (1+ (stream-compression-input-size)))))

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

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

(test-assert "bytevector of 1MiB+1"
  (compress-and-decompress (random-bytevector (1+ (* 1024 1024)))))

(test-assert "bytevector of 2MiB, all compression levels"
  (let ((data (random-bytevector (* 2 1024 1024))))
    (every (lambda (level)
             (compress-and-decompress data #:level level))
           (iota 9 1))))

(test-equal "truncated compressed stream"
  '(zstd-error decompress!)
  (let* ((compressed (compressed-data (random-bytevector 7777)))
         (size       (- (bytevector-length compressed) 142))
         (truncated  (make-bytevector size)))
    (bytevector-copy! compressed 0 truncated 0 size)
    (catch 'zstd-error
      (lambda ()
        (call-with-zstd-input-port (open-bytevector-input-port truncated)
          get-bytevector-all))
      (lambda (key proc . _)
        (list key proc)))))

(test-equal "corrupt compressed stream"
  '(zstd-error decompress! "Restored data doesn't match checksum")
  (let ((compressed (compressed-data (random-bytevector 7777))))
    (bytevector-u8-set! compressed 42
                        (logxor (bytevector-u8-ref compressed 42)
                                #xff))
    (catch 'zstd-error
      (lambda ()
        (call-with-zstd-input-port (open-bytevector-input-port compressed)
          get-bytevector-all))
      (lambda (key proc error . _)
        (list key proc (error-name error))))))

(test-end)