tests: Factorize the network reachability test.

* guix/tests.scm (network-reachable?): New procedure.
* tests/builders.scm (network-reachable?): Remove.
  Replace references to it with calls to the new 'network-reachable?'
  procedure.
* tests/derivations.scm (%coreutils): Use 'network-reachable?' instead
  of 'getaddrinfo'.
* tests/packages.scm: Likewise.
* tests/union.scm: Likewise.
This commit is contained in:
Ludovic Courtès 2015-02-23 23:41:26 +01:00
parent 49685cae2b
commit 12d720fd1a
5 changed files with 12 additions and 14 deletions

View File

@ -31,6 +31,7 @@
#:export (open-connection-for-tests #:export (open-connection-for-tests
random-text random-text
random-bytevector random-bytevector
network-reachable?
mock mock
%substitute-directory %substitute-directory
with-derivation-narinfo with-derivation-narinfo
@ -77,6 +78,10 @@
(loop (1+ i))) (loop (1+ i)))
bv)))) bv))))
(define (network-reachable?)
"Return true if we can reach the Internet."
(false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))
(define-syntax-rule (mock (module proc replacement) body ...) (define-syntax-rule (mock (module proc replacement) body ...)
"Within BODY, replace the definition of PROC from MODULE with the definition "Within BODY, replace the definition of PROC from MODULE with the definition
given by REPLACEMENT." given by REPLACEMENT."

View File

@ -56,16 +56,13 @@
(package-native-search-paths package))) (package-native-search-paths package)))
(@@ (gnu packages commencement) %boot0-inputs))) (@@ (gnu packages commencement) %boot0-inputs)))
(define network-reachable?
(false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))
(define url-fetch* (define url-fetch*
(store-lower url-fetch)) (store-lower url-fetch))
(test-begin "builders") (test-begin "builders")
(unless network-reachable? (test-skip 1)) (unless (network-reachable?) (test-skip 1))
(test-assert "url-fetch" (test-assert "url-fetch"
(let* ((url '("http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz" (let* ((url '("http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz"
"ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")) "ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz"))
@ -97,7 +94,7 @@
(test-assert "gnu-build-system" (test-assert "gnu-build-system"
(build-system? gnu-build-system)) (build-system? gnu-build-system))
(unless network-reachable? (test-skip 1)) (unless (network-reachable?) (test-skip 1))
(test-assert "gnu-build" (test-assert "gnu-build"
(let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz") (let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz")
(hash (nix-base32-string->bytevector (hash (nix-base32-string->bytevector

View File

@ -463,7 +463,7 @@
(define %coreutils (define %coreutils
(false-if-exception (false-if-exception
(and (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV) (and (network-reachable?)
(or (package-derivation %store %bootstrap-coreutils&co) (or (package-derivation %store %bootstrap-coreutils&co)
(nixpkgs-derivation "coreutils"))))) (nixpkgs-derivation "coreutils")))))

View File

@ -176,8 +176,7 @@
(and (direct-store-path? source) (and (direct-store-path? source)
(string-suffix? "utils.scm" source)))) (string-suffix? "utils.scm" source))))
(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)) (unless (network-reachable?) (test-skip 1))
(test-skip 1))
(test-equal "package-source-derivation, snippet" (test-equal "package-source-derivation, snippet"
"OK" "OK"
(let* ((file (search-bootstrap-binary "guile-2.0.9.tar.xz" (let* ((file (search-bootstrap-binary "guile-2.0.9.tar.xz"
@ -532,8 +531,7 @@
(%current-target-system "foo64-linux-gnu")) (%current-target-system "foo64-linux-gnu"))
(equal? drv (bag->derivation %store bag)))))) (equal? drv (bag->derivation %store bag))))))
(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)) (unless (network-reachable?) (test-skip 1))
(test-skip 1))
(test-assert "GNU Make, bootstrap" (test-assert "GNU Make, bootstrap"
;; GNU Make is the first program built during bootstrap; we choose it ;; GNU Make is the first program built during bootstrap; we choose it
;; here so that the test doesn't last for too long. ;; here so that the test doesn't last for too long.

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -84,9 +84,7 @@
(call-with-input-file "bar/two" get-string-all)) (call-with-input-file "bar/two" get-string-all))
(not (file-exists? "bar/one"))))))) (not (file-exists? "bar/one")))))))
(test-skip (if (and %store (test-skip (if (and %store (network-reachable?))
(false-if-exception
(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)))
0 0
1)) 1))