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
|
@ -27,10 +27,12 @@
|
||||||
#:use-module (gnu packages bootstrap)
|
#:use-module (gnu packages bootstrap)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
|
#:use-module (rnrs io ports)
|
||||||
#:use-module (web uri)
|
#:use-module (web uri)
|
||||||
#:export (open-connection-for-tests
|
#:export (open-connection-for-tests
|
||||||
random-text
|
random-text
|
||||||
random-bytevector
|
random-bytevector
|
||||||
|
file=?
|
||||||
network-reachable?
|
network-reachable?
|
||||||
shebang-too-long?
|
shebang-too-long?
|
||||||
mock
|
mock
|
||||||
|
@ -88,6 +90,19 @@
|
||||||
(loop (1+ i)))
|
(loop (1+ i)))
|
||||||
bv))))
|
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?)
|
(define (network-reachable?)
|
||||||
"Return true if we can reach the Internet."
|
"Return true if we can reach the Internet."
|
||||||
(false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))
|
(false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))
|
||||||
|
|
|
@ -108,17 +108,6 @@
|
||||||
(cute string-drop <> (string-length input)))
|
(cute string-drop <> (string-length input)))
|
||||||
(define sibling
|
(define sibling
|
||||||
(compose (cut string-append output <>) strip))
|
(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)
|
(file-system-fold (const #t)
|
||||||
(lambda (name stat result) ; leaf
|
(lambda (name stat result) ; leaf
|
||||||
|
|
Loading…
Reference in New Issue