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