[bug#35880] [PATCH 2/7] utils: Test 'compressed-port' and 'decompressed-port' for both gzip and xz.

[Ludovic Courtès]

* tests/utils.scm (test-compression/decompression): New procedure.
<top level>: Call it for both 'xz and 'gzip.
---
 tests/utils.scm | 61 +++++++++++++++++++++++++++++++------------------
 1 file changed, 39 insertions(+), 22 deletions(-)

diff --git a/tests/utils.scm b/tests/utils.scm
index 3015b21b23..7d55107fda 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -174,30 +174,47 @@
       (any (compose (negate zero?) cdr waitpid)
            pids))))
 
-(test-assert "compressed-port, decompressed-port, non-file"
-  (let ((data (call-with-input-file (search-path %load-path "guix.scm")
-                get-bytevector-all)))
-    (let*-values (((compressed pids1)
-                   (compressed-port 'xz (open-bytevector-input-port data)))
-                  ((decompressed pids2)
-                   (decompressed-port 'xz compressed)))
-      (and (every (compose zero? cdr waitpid)
-                  (append pids1 pids2))
-           (equal? (get-bytevector-all decompressed) data)))))
+(define (test-compression/decompression method run?)
+  "Test METHOD, a symbol such as 'gzip.  Call RUN? to determine whether to
+skip these tests."
+  (unless (run?) (test-skip 1))
+  (test-assert (format #f "compressed-port, decompressed-port, non-file [~a]"
+                       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))))))
 
-(false-if-exception (delete-file temp-file))
-(test-assert "compressed-output-port + decompressed-port"
-  (let* ((file (search-path %load-path "guix/derivations.scm"))
-         (data (call-with-input-file file get-bytevector-all))
-         (port (open-file temp-file "w0b")))
-    (call-with-compressed-output-port 'xz port
-      (lambda (compressed)
-        (put-bytevector compressed data)))
-    (close-port port)
+  (false-if-exception (delete-file temp-file))
+  (unless (run?) (test-skip 1))
+  (test-assert (format #f "compressed-output-port + decompressed-port [~a]"
+                       method)
+    (let* ((file (search-path %load-path "guix/derivations.scm"))
+           (data (call-with-input-file file get-bytevector-all))
+           (port (open-file temp-file "w0b")))
+      (call-with-compressed-output-port method port
+        (lambda (compressed)
+          (put-bytevector compressed data)))
+      (close-port port)
 
-    (bytevector=? data
-                  (call-with-decompressed-port 'xz (open-file temp-file "r0b")
-                    get-bytevector-all))))
+      (bytevector=? data
+                    (call-with-decompressed-port method (open-file temp-file 
"r0b")
+                      get-bytevector-all)))))
+
+(for-each test-compression/decompression
+          '(gzip xz)
+          (list (const #t) (const #f)))
 
 ;; This is actually in (guix store).
 (test-equal "store-path-package-name"
-- 
2.21.0