mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2026-04-06 13:10:33 +02:00
substitute-binary: Support decompression from non-file ports.
* guix/scripts/substitute-binary.scm (filtered-port): Move to utils.scm.
(decompressed-port): Upon "none", return '() as the second value.
(guix-substitute-binary): Expect `decompressed-port' to return a list
of PIDs as its second value.
* guix/utils.scm (filtered-port): New procedure. Add case for when
INPUT is not `file-port?'.
* tests/utils.scm ("filtered-port, file", "filtered-port, non-file"):
New tests.
This commit is contained in:
@@ -17,12 +17,14 @@
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (test-utils)
|
||||
#:use-module ((guix config) #:select (%gzip))
|
||||
#:use-module (guix utils)
|
||||
#:use-module ((guix store) #:select (%store-prefix store-path-package-name))
|
||||
#: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))
|
||||
|
||||
(test-begin "utils")
|
||||
@@ -89,6 +91,31 @@
|
||||
'(0 1 2 3)))
|
||||
list))
|
||||
|
||||
(test-assert "filtered-port, file"
|
||||
(let ((file (search-path %load-path "guix.scm")))
|
||||
(call-with-input-file file
|
||||
(lambda (input)
|
||||
(let*-values (((compressed pids1)
|
||||
(filtered-port `(,%gzip "-c" "--fast") input))
|
||||
((decompressed pids2)
|
||||
(filtered-port `(,%gzip "-d") compressed)))
|
||||
(and (every (compose zero? cdr waitpid)
|
||||
(append pids1 pids2))
|
||||
(equal? (get-bytevector-all decompressed)
|
||||
(call-with-input-file file get-bytevector-all))))))))
|
||||
|
||||
(test-assert "filtered-port, non-file"
|
||||
(let ((data (call-with-input-file (search-path %load-path "guix.scm")
|
||||
get-bytevector-all)))
|
||||
(let*-values (((compressed pids1)
|
||||
(filtered-port `(,%gzip "-c" "--fast")
|
||||
(open-bytevector-input-port data)))
|
||||
((decompressed pids2)
|
||||
(filtered-port `(,%gzip "-d") compressed)))
|
||||
(and (pk (every (compose zero? cdr waitpid)
|
||||
(append pids1 pids2)))
|
||||
(equal? (get-bytevector-all decompressed) data)))))
|
||||
|
||||
(test-assert "define-record-type*"
|
||||
(begin
|
||||
(define-record-type* <foo> foo make-foo
|
||||
|
||||
Reference in New Issue
Block a user