futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

utils: Test 'compressed-port' and 'decompressed-port' for both gzip and xz.

Browse Source 
* tests/utils.scm (test-compression/decompression): New procedure.
<top level>: Call it for both 'xz and 'gzip.
This commit is contained in:
Ludovic Courtès 2019-05-23 22:11:33 +02:00
parent 2a991f3ae4
commit 4c7ebe318f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 40 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
tests/utils.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; ;;;
@ -174,30 +174,47 @@
(any (compose (negate zero?) cdr waitpid) (any (compose (negate zero?) cdr waitpid)
pids)))) pids))))
(test-assert "compressed-port, decompressed-port, non-file" (define (test-compression/decompression method run?)
(let ((data (call-with-input-file (search-path %load-path "guix.scm") "Test METHOD, a symbol such as 'gzip. Call RUN? to determine whether to
get-bytevector-all))) skip these tests."
(let*-values (((compressed pids1) (unless (run?) (test-skip 1))
(compressed-port 'xz (open-bytevector-input-port data))) (test-assert (format #f "compressed-port, decompressed-port, non-file [~a]"
((decompressed pids2) method)
(decompressed-port 'xz compressed))) (let ((data (call-with-input-file (search-path %load-path "guix.scm")
(and (every (compose zero? cdr waitpid) get-bytevector-all)))
(append pids1 pids2)) (let*-values (((compressed pids1)
(equal? (get-bytevector-all decompressed) data))))) (compressed-port method (open-bytevector-input-port data)))
((decompressed pids2)
(decompressed-port method compressed)))
(and (every (compose zero? cdr waitpid)
(pk 'pids method (append pids1 pids2)))
(let ((result (get-bytevector-all decompressed)))
(pk 'len method
(if (bytevector? result)
(bytevector-length result)
result)
(bytevector-length data))
(equal? result data))))))
(false-if-exception (delete-file temp-file)) (false-if-exception (delete-file temp-file))
(test-assert "compressed-output-port + decompressed-port" (unless (run?) (test-skip 1))
(let* ((file (search-path %load-path "guix/derivations.scm")) (test-assert (format #f "compressed-output-port + decompressed-port [~a]"
(data (call-with-input-file file get-bytevector-all)) method)
(port (open-file temp-file "w0b"))) (let* ((file (search-path %load-path "guix/derivations.scm"))
(call-with-compressed-output-port 'xz port (data (call-with-input-file file get-bytevector-all))
(lambda (compressed) (port (open-file temp-file "w0b")))
(put-bytevector compressed data))) (call-with-compressed-output-port method port
(close-port port) (lambda (compressed)
(put-bytevector compressed data)))
(close-port port)
(bytevector=? data (bytevector=? data
(call-with-decompressed-port 'xz (open-file temp-file "r0b") (call-with-decompressed-port method (open-file temp-file "r0b")
get-bytevector-all)))) get-bytevector-all)))))
(for-each test-compression/decompression
'(gzip xz lzip)
(list (const #t) (const #t)))
;; This is actually in (guix store). ;; This is actually in (guix store).
(test-equal "store-path-package-name" (test-equal "store-path-package-name"