From patchwork Fri May 24 13:42:33 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 14058 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 1FDD917040; Fri, 24 May 2019 14:43:07 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id B4A381700D for ; Fri, 24 May 2019 14:43:06 +0100 (BST) Received: from localhost ([127.0.0.1]:54873 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hUATS-0008Oz-BI for patchwork@mira.cbaines.net; Fri, 24 May 2019 09:43:06 -0400 Received: from eggs.gnu.org ([209.51.188.92]:36869) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hUATP-0008Oh-6x for guix-patches@gnu.org; Fri, 24 May 2019 09:43:04 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hUATO-0008MG-3A for guix-patches@gnu.org; Fri, 24 May 2019 09:43:03 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:60989) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hUATN-0008MB-W3 for guix-patches@gnu.org; Fri, 24 May 2019 09:43:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hUATN-0002PJ-T0 for guix-patches@gnu.org; Fri, 24 May 2019 09:43:01 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#35880] [PATCH 2/7] utils: Test 'compressed-port' and 'decompressed-port' for both gzip and xz. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 24 May 2019 13:43:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 35880 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 35880@debbugs.gnu.org Received: via spool by 35880-submit@debbugs.gnu.org id=B35880.15587053759208 (code B ref 35880); Fri, 24 May 2019 13:43:01 +0000 Received: (at 35880) by debbugs.gnu.org; 24 May 2019 13:42:55 +0000 Received: from localhost ([127.0.0.1]:46293 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hUATH-0002OQ-EB for submit@debbugs.gnu.org; Fri, 24 May 2019 09:42:55 -0400 Received: from eggs.gnu.org ([209.51.188.92]:50660) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hUATE-0002Nr-Sz for 35880@debbugs.gnu.org; Fri, 24 May 2019 09:42:54 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:38747) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hUAT9-0008Cl-Nn; Fri, 24 May 2019 09:42:47 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=36484 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1hUAT9-0007iN-8Z; Fri, 24 May 2019 09:42:47 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Fri, 24 May 2019 15:42:33 +0200 Message-Id: <20190524134238.22802-2-ludo@gnu.org> X-Mailer: git-send-email 2.21.0 In-Reply-To: <20190524134238.22802-1-ludo@gnu.org> References: <20190524134238.22802-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Pierre Neidhardt Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * tests/utils.scm (test-compression/decompression): New procedure. : 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"