mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
tests: Move 'file=?' to (guix tests).
* tests/nar.scm (file-tree-equal?)[file=?]: Move to... * guix/tests.scm (file=?): ... here. New procedure.
This commit is contained in:
parent
31fbf4b637
commit
8de3df72bc
2 changed files with 15 additions and 11 deletions
|
@ -27,10 +27,12 @@ (define-module (guix tests)
|
|||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (web uri)
|
||||
#:export (open-connection-for-tests
|
||||
random-text
|
||||
random-bytevector
|
||||
file=?
|
||||
network-reachable?
|
||||
shebang-too-long?
|
||||
mock
|
||||
|
@ -88,6 +90,19 @@ (define (random-bytevector n)
|
|||
(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 (network-reachable?)
|
||||
"Return true if we can reach the Internet."
|
||||
(false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))
|
||||
|
|
|
@ -108,17 +108,6 @@ (define strip
|
|||
(cute string-drop <> (string-length input)))
|
||||
(define sibling
|
||||
(compose (cut string-append output <>) strip))
|
||||
(define (file=? a b)
|
||||
(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))))))
|
||||
|
||||
(file-system-fold (const #t)
|
||||
(lambda (name stat result) ; leaf
|
||||
|
|
Loading…
Reference in a new issue