From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([208.118.235.92]:37113) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gd1dj-0003G0-LR for guix-patches@gnu.org; Fri, 28 Dec 2018 18:34:04 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gd1NG-0003ne-Vb for guix-patches@gnu.org; Fri, 28 Dec 2018 18:17:04 -0500 Received: from debbugs.gnu.org ([208.118.235.43]:33442) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1gd1NG-0003mz-Ew for guix-patches@gnu.org; Fri, 28 Dec 2018 18:17:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1gd1NG-0001Rd-9P for guix-patches@gnu.org; Fri, 28 Dec 2018 18:17:02 -0500 Subject: [bug#33899] [PATCH 2/5] tests: 'file=?' now recurses on directories. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Sat, 29 Dec 2018 00:15:51 +0100 Message-Id: <20181228231554.8220-2-ludo@gnu.org> In-Reply-To: <20181228231554.8220-1-ludo@gnu.org> References: <20181228231554.8220-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 33899@debbugs.gnu.org * guix/tests.scm (not-dot?): New procedure. (file=?)[executable?]: New procedure. In 'regular case, check whether the executable bit is preserved. Add 'directory case. --- guix/tests.scm | 26 ++++++++++++++++++++++---- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/guix/tests.scm b/guix/tests.scm index f4948148c4..c9ae2718e4 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -26,9 +26,12 @@ #:use-module (gcrypt hash) #:use-module (guix build-system gnu) #:use-module (gnu packages bootstrap) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-64) #:use-module (rnrs bytevectors) + #:use-module (ice-9 ftw) #:use-module (ice-9 binary-ports) #:use-module (web uri) #:export (open-connection-for-tests @@ -138,16 +141,31 @@ too expensive to build entirely in the test store." (loop (1+ i))) bv)))) +(define (not-dot? entry) + (not (member entry '("." "..")))) + (define (file=? a b) - "Return true if files A and B have the same type and same content." + "Return true if files A and B have the same type and same content, +recursively." + (define (executable? file) + (->bool (logand (stat:mode (lstat file)) #o100))) + (and (eq? (stat:type (lstat a)) (stat:type (lstat b))) (case (stat:type (lstat a)) ((regular) - (equal? - (call-with-input-file a get-bytevector-all) - (call-with-input-file b get-bytevector-all))) + (and (eqv? (executable? a) (executable? b)) + (equal? + (call-with-input-file a get-bytevector-all) + (call-with-input-file b get-bytevector-all)))) ((symlink) (string=? (readlink a) (readlink b))) + ((directory) + (let ((lst1 (scandir a not-dot?)) + (lst2 (scandir b not-dot?))) + (and (equal? lst1 lst2) + (every file=? + (map (cut string-append a "/" <>) lst1) + (map (cut string-append b "/" <>) lst2))))) (else (error "what?" (lstat a)))))) -- 2.20.1