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:
parent
49685cae2b
commit
12d720fd1a
|
@ -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."
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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")))))
|
||||||
|
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue