[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/08: tests: Factorize 'file=?'.
From: |
guix-commits |
Subject: |
02/08: tests: Factorize 'file=?'. |
Date: |
Tue, 16 Nov 2021 08:38:53 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit f39397b21041fe418247239f27473aff49a203c9
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Nov 13 16:11:25 2021 +0100
tests: Factorize 'file=?'.
* guix/tests.scm (file=?): Add optional 'stat' parameter. Add fast
patch comparing inode numbers.
* tests/gexp.scm ("imported-files with file-like objects"): Remove
'file=?' procedure and use the one from (guix tests).
---
guix/tests.scm | 30 +++++++++++++++++-------------
tests/gexp.scm | 11 +++--------
2 files changed, 20 insertions(+), 21 deletions(-)
diff --git a/guix/tests.scm b/guix/tests.scm
index fc3d521..e1c1943 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès
<ludo@gnu.org>
+;;; Copyright © 2013-2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -182,18 +182,22 @@ too expensive to build entirely in the test store."
(loop (1+ i)))
bv))))
-(define (file=? a b)
- "Return true if files A and B have the same type and same content."
- (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)))
- ((symlink)
- (string=? (readlink a) (readlink b)))
- (else
- (error "what?" (lstat a))))))
+(define* (file=? a b #:optional (stat lstat))
+ "Return true if files A and B have the same type and same content. Call
+STAT to obtain file metadata."
+ (let ((sta (stat a)) (stb (stat b)))
+ (and (eq? (stat:type sta) (stat:type stb))
+ (case (stat:type sta)
+ ((regular)
+ (or (and (= (stat:ino sta) (stat:ino stb))
+ (= (stat:dev sta) (stat:dev stb)))
+ (equal?
+ (call-with-input-file a get-bytevector-all)
+ (call-with-input-file b get-bytevector-all))))
+ ((symlink)
+ (string=? (readlink a) (readlink b)))
+ (else
+ (error "what?" (stat a)))))))
(define (canonical-file? file)
"Return #t if FILE is in the store, is read-only, and its mtime is 1."
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 39a47d4..0758a49 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès
<ludo@gnu.org>
+;;; Copyright © 2014-2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
@@ -827,19 +827,14 @@
(files -> `(("a/b/c" . ,q-scm)
("p/q" . ,plain)))
(drv (imported-files files)))
- (define (file=? file1 file2)
- ;; Assume deduplication is in place.
- (= (stat:ino (stat file1))
- (stat:ino (stat file2))))
-
(mbegin %store-monad
(built-derivations (list (pk 'drv drv)))
(mlet %store-monad ((dir -> (derivation->output-path drv))
(plain* (text-file "foo" "bar!"))
(q-scm* (interned-file q-scm "c")))
(return
- (and (file=? (string-append dir "/a/b/c") q-scm*)
- (file=? (string-append dir "/p/q") plain*)))))))
+ (and (file=? (string-append dir "/a/b/c") q-scm* stat)
+ (file=? (string-append dir "/p/q") plain* stat)))))))
(test-equal "gexp-modules & ungexp"
'((bar) (foo))
- branch master updated (b2f8186 -> 9bbbac6), guix-commits, 2021/11/16
- 07/08: gnu: Add texlive-translator., guix-commits, 2021/11/16
- 01/08: services: openssh: Collect all keys for all users., guix-commits, 2021/11/16
- 03/08: daemon: Do not deduplicate files smaller than 8 KiB., guix-commits, 2021/11/16
- 05/08: home: services: bash: Emit 'extra-content' first again., guix-commits, 2021/11/16
- 08/08: gnu: Add texlive-latex-textpos., guix-commits, 2021/11/16
- 02/08: tests: Factorize 'file=?'.,
guix-commits <=
- 04/08: home: services: Fix typo., guix-commits, 2021/11/16
- 06/08: home: Adjust 'guix home import' test for shell aliases., guix-commits, 2021/11/16