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:
Ludovic Courtès 2015-06-24 15:00:34 +02:00
parent 31fbf4b637
commit 8de3df72bc
2 changed files with 15 additions and 11 deletions

View file

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

View file

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