01/02: utils: (de)compressed-port does not closed wrapped port when using 'none'.

[Ludovic Courtès]

civodul pushed a commit to branch wip-offload-compression
in repository guix.

commit 97e60e341d4e7da770fe4a3d70a6c4b8a2baa8c2
Author: Ludovic Courtès <address@hidden>
Date:   Mon Aug 1 17:27:58 2016 +0200

    utils: (de)compressed-port does not closed wrapped port when using 'none'.
    
    This fixes a bug whereby, for the 'none compression method, we'd close
    the wrapped port, whereas for other methods the wrapped port is not
    closed.
    
    * guix/utils.scm (decompressed-port, compressed-port,
    compressed-output-port): Add call to 'duplicate-port' for the 'none
    case.
    * tests/utils.scm ("compressed-output-port + decompressed-port"): Check
    the return value of 'close-port'.
    ("compressed-output-port + decompressed-port, 'none'"): New test.
---
 guix/utils.scm  |    6 +++---
 tests/utils.scm |   29 +++++++++++++++++++++++++----
 2 files changed, 28 insertions(+), 7 deletions(-)

diff --git a/guix/utils.scm b/guix/utils.scm
index 9e1b8ea..4c6b331 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -212,7 +212,7 @@ buffered data is lost."
   "Return an input port where INPUT is decompressed according to COMPRESSION,
 a symbol such as 'xz."
   (match compression
-    ((or #f 'none) (values input '()))
+    ((or #f 'none) (values (duplicate-port input "rb") '()))
     ('bzip2        (filtered-port `(,%bzip2 "-dc") input))
     ('xz           (filtered-port `(,%xz "-dc") input))
     ('gzip         (filtered-port `(,%gzip "-dc") input))
@@ -222,7 +222,7 @@ a symbol such as 'xz."
   "Return an input port where INPUT is decompressed according to COMPRESSION,
 a symbol such as 'xz."
   (match compression
-    ((or #f 'none) (values input '()))
+    ((or #f 'none) (values (duplicate-port input "rb") '()))
     ('bzip2        (filtered-port `(,%bzip2 "-c") input))
     ('xz           (filtered-port `(,%xz "-c") input))
     ('gzip         (filtered-port `(,%gzip "-c") input))
@@ -279,7 +279,7 @@ a symbol such as 'xz, and then written to OUTPUT.  In 
addition return a list
 of PIDs to wait for.  OPTIONS is a list of strings passed to the compression
 program--e.g., '(\"--fast\")."
   (match compression
-    ((or #f 'none) (values output '()))
+    ((or #f 'none) (values (duplicate-port output "wb") '()))
     ('bzip2        (filtered-output-port `(,%bzip2 "-c" ,@options) output))
     ('xz           (filtered-output-port `(,%xz "-c" ,@options) output))
     ('gzip         (filtered-output-port `(,%gzip "-c" ,@options) output))
diff --git a/tests/utils.scm b/tests/utils.scm
index 6590ed9..be38a1e 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -162,11 +162,32 @@
     (call-with-compressed-output-port 'xz 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))))
+    ;; PORT must not be closed yet.
+    (and (close-port port)
+         (bytevector=? data
+                       (let* ((port   (open-file temp-file "r0b"))
+                              (result (call-with-decompressed-port 'xz port
+                                        get-bytevector-all)))
+                         (and (close-port port) result))))))
+
+(false-if-exception (delete-file temp-file))
+(test-assert "compressed-output-port + decompressed-port, 'none'"
+  (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 'none port
+      (lambda (compressed)
+        (put-bytevector compressed data)))
+
+    ;; PORT must not be closed yet.
+    (and (close-port port)
+         (bytevector=? data
+                       (let* ((port   (open-file temp-file "rb"))
+                              (result (call-with-decompressed-port 'none port
+                                        get-bytevector-all)))
+                         (and (close-port port)
+                              result))))))
 
 ;; This is actually in (guix store).
 (test-equal "store-path-package-name"