mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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).
This commit is contained in:
parent
b4b2bbf4fb
commit
f39397b210
2 changed files with 20 additions and 21 deletions
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -182,18 +182,22 @@ (define (random-bytevector n)
|
||||||
(loop (1+ i)))
|
(loop (1+ i)))
|
||||||
bv))))
|
bv))))
|
||||||
|
|
||||||
(define (file=? a b)
|
(define* (file=? a b #:optional (stat lstat))
|
||||||
"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. Call
|
||||||
(and (eq? (stat:type (lstat a)) (stat:type (lstat b)))
|
STAT to obtain file metadata."
|
||||||
(case (stat:type (lstat a))
|
(let ((sta (stat a)) (stb (stat b)))
|
||||||
|
(and (eq? (stat:type sta) (stat:type stb))
|
||||||
|
(case (stat:type sta)
|
||||||
((regular)
|
((regular)
|
||||||
|
(or (and (= (stat:ino sta) (stat:ino stb))
|
||||||
|
(= (stat:dev sta) (stat:dev stb)))
|
||||||
(equal?
|
(equal?
|
||||||
(call-with-input-file a get-bytevector-all)
|
(call-with-input-file a get-bytevector-all)
|
||||||
(call-with-input-file b get-bytevector-all)))
|
(call-with-input-file b get-bytevector-all))))
|
||||||
((symlink)
|
((symlink)
|
||||||
(string=? (readlink a) (readlink b)))
|
(string=? (readlink a) (readlink b)))
|
||||||
(else
|
(else
|
||||||
(error "what?" (lstat a))))))
|
(error "what?" (stat a)))))))
|
||||||
|
|
||||||
(define (canonical-file? file)
|
(define (canonical-file? file)
|
||||||
"Return #t if FILE is in the store, is read-only, and its mtime is 1."
|
"Return #t if FILE is in the store, is read-only, and its mtime is 1."
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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>
|
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
@ -827,19 +827,14 @@ (define (canonical-file? file)
|
||||||
(files -> `(("a/b/c" . ,q-scm)
|
(files -> `(("a/b/c" . ,q-scm)
|
||||||
("p/q" . ,plain)))
|
("p/q" . ,plain)))
|
||||||
(drv (imported-files files)))
|
(drv (imported-files files)))
|
||||||
(define (file=? file1 file2)
|
|
||||||
;; Assume deduplication is in place.
|
|
||||||
(= (stat:ino (stat file1))
|
|
||||||
(stat:ino (stat file2))))
|
|
||||||
|
|
||||||
(mbegin %store-monad
|
(mbegin %store-monad
|
||||||
(built-derivations (list (pk 'drv drv)))
|
(built-derivations (list (pk 'drv drv)))
|
||||||
(mlet %store-monad ((dir -> (derivation->output-path drv))
|
(mlet %store-monad ((dir -> (derivation->output-path drv))
|
||||||
(plain* (text-file "foo" "bar!"))
|
(plain* (text-file "foo" "bar!"))
|
||||||
(q-scm* (interned-file q-scm "c")))
|
(q-scm* (interned-file q-scm "c")))
|
||||||
(return
|
(return
|
||||||
(and (file=? (string-append dir "/a/b/c") q-scm*)
|
(and (file=? (string-append dir "/a/b/c") q-scm* stat)
|
||||||
(file=? (string-append dir "/p/q") plain*)))))))
|
(file=? (string-append dir "/p/q") plain* stat)))))))
|
||||||
|
|
||||||
(test-equal "gexp-modules & ungexp"
|
(test-equal "gexp-modules & ungexp"
|
||||||
'((bar) (foo))
|
'((bar) (foo))
|
||||||
|
|
Loading…
Reference in a new issue