ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

tests: Factorize 'file=?'.

Browse source 
* 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:
Ludovic Courtès 2021-11-13 16:11:25 +01:00
parent b4b2bbf4fb
commit f39397b210
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 20 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
guix/tests.scm
View file

@ -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)))
((regular) (and (eq? (stat:type sta) (stat:type stb))
(equal? (case (stat:type sta)
(call-with-input-file a get-bytevector-all) ((regular)
(call-with-input-file b get-bytevector-all))) (or (and (= (stat:ino sta) (stat:ino stb))
((symlink) (= (stat:dev sta) (stat:dev stb)))
(string=? (readlink a) (readlink b))) (equal?
(else (call-with-input-file a get-bytevector-all)
(error "what?" (lstat a)))))) (call-with-input-file b get-bytevector-all))))
((symlink)
(string=? (readlink a) (readlink b)))
(else
(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."

11
tests/gexp.scm
View file

@ -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))