diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2021-11-13 16:11:25 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-11-16 14:34:28 +0100 |
| commit | f39397b21041fe418247239f27473aff49a203c9 (patch) | |
| tree | 80323acc22ce727908182b70cc030f309a6dd76a /guix/tests.scm | |
| parent | b4b2bbf4fb74c9f3e93d64863ab9b38957494b49 (diff) | |
| download | guix-f39397b21041fe418247239f27473aff49a203c9.tar guix-f39397b21041fe418247239f27473aff49a203c9.tar.gz | |
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).
Diffstat (limited to 'guix/tests.scm')
| -rw-r--r-- | guix/tests.scm | 30 |
1 files changed, 17 insertions, 13 deletions
diff --git a/guix/tests.scm b/guix/tests.scm index fc3d521163..e1c194340c 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." |