summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--guix/utils.scm13
-rw-r--r--tests/utils.scm43
2 files changed, 29 insertions, 27 deletions
diff --git a/guix/utils.scm b/guix/utils.scm
index 0df46f1062..c321ad9943 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -110,7 +110,6 @@
             edit-expression
 
             filtered-port
-            compressed-port
             decompressed-port
             call-with-decompressed-port
             compressed-output-port
@@ -225,18 +224,6 @@ a symbol such as 'xz."
                            '()))
     (_             (error "unsupported compression scheme" compression))))
 
-(define (compressed-port compression input)
-  "Return an input port where INPUT is compressed according to COMPRESSION,
-a symbol such as 'xz."
-  (match compression
-    ((or #f 'none) (values input '()))
-    ('bzip2        (filtered-port `(,%bzip2 "-c") input))
-    ('xz           (filtered-port `(,%xz "-c") input))
-    ('gzip         (filtered-port `(,%gzip "-c") input))
-    ('lzip         (values (lzip-port 'make-lzip-input-port/compressed input)
-                           '()))
-    (_             (error "unsupported compression scheme" compression))))
-
 (define (call-with-decompressed-port compression port proc)
   "Call PROC with a wrapper around PORT, a file port, that decompresses data
 read from PORT according to COMPRESSION, a symbol such as 'xz."
diff --git a/tests/utils.scm b/tests/utils.scm
index 009e2121ab..c278b2a277 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;;
@@ -182,19 +182,34 @@ skip these tests."
                        method)
     (let ((data (call-with-input-file (search-path %load-path "guix.scm")
                   get-bytevector-all)))
-      (let*-values (((compressed pids1)
-                     (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))))))
+      (call-with-temporary-output-file
+       (lambda (output port)
+         (close-port port)
+         (let*-values (((compressed pids)
+                        ;; Note: 'compressed-output-port' only supports file
+                        ;; ports.
+                        (compressed-output-port method
+                                                (open-file output "w0"))))
+           (put-bytevector compressed data)
+           (close-port compressed)
+           (and (every (compose zero? cdr waitpid)
+                       (pk 'pids method pids))
+                (let*-values (((decompressed pids)
+                               (decompressed-port method
+                                                  (open-bytevector-input-port
+                                                   (call-with-input-file output
+                                                     get-bytevector-all))))
+                              ((result)
+                               (get-bytevector-all decompressed)))
+                  (close-port decompressed)
+                  (pk 'len method
+                      (if (bytevector? result)
+                          (bytevector-length result)
+                          result)
+                      (bytevector-length data))
+                  (and (every (compose zero? cdr waitpid)
+                              (pk 'pids method pids))
+                       (equal? result data)))))))))
 
   (false-if-exception (delete-file temp-file))
   (unless (run?) (test-skip 1))