summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-06-24 15:00:34 +0200
committerLudovic Courtès <ludo@gnu.org>2015-06-24 18:05:03 +0200
commit8de3df72bc96cc3f7739e61699831557852cea6b (patch)
tree54f5b186e73c69d7edef9e75becc4fe7c696bc41
parent31fbf4b6377d9a1c44eb3230b89f0bac47a202b4 (diff)
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.scm15
-rw-r--r--tests/nar.scm11
2 files changed, 15 insertions, 11 deletions
diff --git a/guix/tests.scm b/guix/tests.scm
index a19eda250c9..16b8cc7f8ac 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -27,10 +27,12 @@
27 #:use-module (gnu packages bootstrap) 27 #:use-module (gnu packages bootstrap)
28 #:use-module (srfi srfi-34) 28 #:use-module (srfi srfi-34)
29 #:use-module (rnrs bytevectors) 29 #:use-module (rnrs bytevectors)
30 #:use-module (rnrs io ports)
30 #:use-module (web uri) 31 #:use-module (web uri)
31 #:export (open-connection-for-tests 32 #:export (open-connection-for-tests
32 random-text 33 random-text
33 random-bytevector 34 random-bytevector
35 file=?
34 network-reachable? 36 network-reachable?
35 shebang-too-long? 37 shebang-too-long?
36 mock 38 mock
@@ -88,6 +90,19 @@
88 (loop (1+ i))) 90 (loop (1+ i)))
89 bv)))) 91 bv))))
90 92
93(define (file=? a b)
94 "Return true if files A and B have the same type and same content."
95 (and (eq? (stat:type (lstat a)) (stat:type (lstat b)))
96 (case (stat:type (lstat a))
97 ((regular)
98 (equal?
99 (call-with-input-file a get-bytevector-all)
100 (call-with-input-file b get-bytevector-all)))
101 ((symlink)
102 (string=? (readlink a) (readlink b)))
103 (else
104 (error "what?" (lstat a))))))
105
91(define (network-reachable?) 106(define (network-reachable?)
92 "Return true if we can reach the Internet." 107 "Return true if we can reach the Internet."
93 (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))) 108 (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))
diff --git a/tests/nar.scm b/tests/nar.scm
index 4ccd3648618..b8e50c7603d 100644
--- a/tests/nar.scm
+++ b/tests/nar.scm
@@ -108,17 +108,6 @@
108 (cute string-drop <> (string-length input))) 108 (cute string-drop <> (string-length input)))
109 (define sibling 109 (define sibling
110 (compose (cut string-append output <>) strip)) 110 (compose (cut string-append output <>) strip))
111 (define (file=? a b)
112 (and (eq? (stat:type (lstat a)) (stat:type (lstat b)))
113 (case (stat:type (lstat a))
114 ((regular)
115 (equal?
116 (call-with-input-file a get-bytevector-all)
117 (call-with-input-file b get-bytevector-all)))
118 ((symlink)
119 (string=? (readlink a) (readlink b)))
120 (else
121 (error "what?" (lstat a))))))
122 111
123 (file-system-fold (const #t) 112 (file-system-fold (const #t)
124 (lambda (name stat result) ; leaf 113 (lambda (name stat result) ; leaf