From 12d720fd1a9c43019f2d5afa051b45c7633b3ab0 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 23 Feb 2015 23:41:26 +0100
Subject: 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.
---
 guix/tests.scm        | 5 +++++
 tests/builders.scm    | 7 ++-----
 tests/derivations.scm | 2 +-
 tests/packages.scm    | 6 ++----
 tests/union.scm       | 6 ++----
 5 files changed, 12 insertions(+), 14 deletions(-)

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 <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; 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))
 
-- 
cgit v1.2.3