diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-06-24 15:00:34 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-06-24 18:05:03 +0200 |
| commit | 8de3df72bc96cc3f7739e61699831557852cea6b (patch) | |
| tree | 54f5b186e73c69d7edef9e75becc4fe7c696bc41 | |
| parent | 31fbf4b6377d9a1c44eb3230b89f0bac47a202b4 (diff) | |
| download | guix-8de3df72bc96cc3f7739e61699831557852cea6b.tar guix-8de3df72bc96cc3f7739e61699831557852cea6b.tar.gz | |
tests: Move 'file=?' to (guix tests).
* tests/nar.scm (file-tree-equal?)[file=?]: Move to...
* guix/tests.scm (file=?): ... here. New procedure.
| -rw-r--r-- | guix/tests.scm | 15 | ||||
| -rw-r--r-- | tests/nar.scm | 11 |
2 files changed, 15 insertions, 11 deletions
diff --git a/guix/tests.scm b/guix/tests.scm index a19eda250c..16b8cc7f8a 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -27,10 +27,12 @@ #: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 @@ (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))) diff --git a/tests/nar.scm b/tests/nar.scm index 4ccd364861..b8e50c7603 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -108,17 +108,6 @@ (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 |