From f4cbc586fa09f24214261d2ee4e1e6a213a6c2d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 28 Dec 2018 15:58:58 +0100 Subject: [PATCH 2/5] =?UTF-8?q?tests:=20'file=3D=3F'=20now=20recurses=20on?= =?UTF-8?q?=20directories.?= * 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 | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/guix/tests.scm b/guix/tests.scm index fc3d521163..d0f9e6d35a 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -30,11 +30,13 @@ #:use-module (guix build-system gnu) #:use-module (gnu packages base) #: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 match) + #:use-module (ice-9 ftw) #:use-module (ice-9 binary-ports) #:use-module (web uri) #:export (open-connection-for-tests @@ -182,16 +184,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.29.2