diff --git a/guix/tests.scm b/guix/tests.scm index 1171bb4dfb..d004a50a36 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -31,6 +31,7 @@ #:export (open-connection-for-tests random-text random-bytevector + network-reachable? mock %substitute-directory with-derivation-narinfo @@ -77,6 +78,10 @@ (loop (1+ i))) 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 ...) "Within BODY, replace the definition of PROC from MODULE with the definition given by REPLACEMENT." diff --git a/tests/builders.scm b/tests/builders.scm index e5acc3e038..3c2a3edc8e 100644 --- a/tests/builders.scm +++ b/tests/builders.scm @@ -56,16 +56,13 @@ (package-native-search-paths package))) (@@ (gnu packages commencement) %boot0-inputs))) -(define network-reachable? - (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))) - (define url-fetch* (store-lower url-fetch)) (test-begin "builders") -(unless network-reachable? (test-skip 1)) +(unless (network-reachable?) (test-skip 1)) (test-assert "url-fetch" (let* ((url '("http://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" (build-system? gnu-build-system)) -(unless network-reachable? (test-skip 1)) +(unless (network-reachable?) (test-skip 1)) (test-assert "gnu-build" (let* ((url "http://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz") (hash (nix-base32-string->bytevector diff --git a/tests/derivations.scm b/tests/derivations.scm index e23bdeed77..72d253c465 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -463,7 +463,7 @@ (define %coreutils (false-if-exception - (and (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV) + (and (network-reachable?) (or (package-derivation %store %bootstrap-coreutils&co) (nixpkgs-derivation "coreutils"))))) diff --git a/tests/packages.scm b/tests/packages.scm index 851520b343..5725b0a8a9 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -176,8 +176,7 @@ (and (direct-store-path? source) (string-suffix? "utils.scm" source)))) -(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)) - (test-skip 1)) +(unless (network-reachable?) (test-skip 1)) (test-equal "package-source-derivation, snippet" "OK" (let* ((file (search-bootstrap-binary "guile-2.0.9.tar.xz" @@ -532,8 +531,7 @@ (%current-target-system "foo64-linux-gnu")) (equal? drv (bag->derivation %store bag)))))) -(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)) - (test-skip 1)) +(unless (network-reachable?) (test-skip 1)) (test-assert "GNU Make, bootstrap" ;; GNU Make is the first program built during bootstrap; we choose it ;; here so that the test doesn't last for too long. diff --git a/tests/union.scm b/tests/union.scm index 7e55670b86..22ba67ce99 100644 --- a/tests/union.scm +++ b/tests/union.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -84,9 +84,7 @@ (call-with-input-file "bar/two" get-string-all)) (not (file-exists? "bar/one"))))))) -(test-skip (if (and %store - (false-if-exception - (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))) +(test-skip (if (and %store (network-reachable?)) 0 1))