aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/builders.scm8
-rw-r--r--tests/cpan.scm14
-rw-r--r--tests/derivations.scm19
-rw-r--r--tests/gexp.scm51
-rw-r--r--tests/guix-package.sh13
-rw-r--r--tests/packages.scm5
-rw-r--r--tests/ui.scm40
-rw-r--r--tests/union.scm6
8 files changed, 113 insertions, 43 deletions
diff --git a/tests/builders.scm b/tests/builders.scm
index e5acc3e038..a7c3e42830 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,8 @@
(test-assert "gnu-build-system"
(build-system? gnu-build-system))
-(unless network-reachable? (test-skip 1))
+(when (or (not (network-reachable?)) (shebang-too-long?))
+ (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/cpan.scm b/tests/cpan.scm
index af7b36e684..2f9513519e 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -28,15 +28,8 @@
"{
\"metadata\" : {
\"prereqs\" : {
- \"configure\" : {
- \"requires\" : {
- \"ExtUtils::MakeMaker\" : \"0\",
- \"Module::Build\" : \"0.28\"
- }
- },
\"runtime\" : {
\"requires\" : {
- \"Getopt::Std\" : \"0\",
\"Test::Script\" : \"1.05\",
}
}
@@ -70,6 +63,8 @@
(match url
("http://api.metacpan.org/release/Foo-Bar"
test-json)
+ ("http://api.metacpan.org/module/Test::Script"
+ "{ \"distribution\" : \"Test-Script\" }")
("http://example.com/Foo-Bar-0.1.tar.gz"
test-source)
(_ (error "Unexpected URL: " url))))))))
@@ -85,16 +80,13 @@
('base32
(? string? hash)))))
('build-system 'perl-build-system)
- ('native-inputs
- ('quasiquote
- (("perl-module-build" ('unquote 'perl-module-build)))))
('inputs
('quasiquote
(("perl-test-script" ('unquote 'perl-test-script)))))
('home-page "http://search.cpan.org/dist/Foo-Bar")
('synopsis "Fizzle Fuzz")
('description 'fill-in-yourself!)
- ('license 'gpl1+))
+ ('license (package-license perl)))
(string=? (bytevector->nix-base32-string
(call-with-input-string test-source port-sha256))
hash))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 80aabad3a8..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")))))
@@ -670,23 +670,6 @@
(let ((p (derivation->output-path drv)))
(string-contains (call-with-input-file p read-line) "GNU")))))
-(test-assert "imported-files"
- (let* ((files `(("x" . ,(search-path %load-path "ice-9/q.scm"))
- ("a/b/c" . ,(search-path %load-path
- "guix/derivations.scm"))
- ("p/q" . ,(search-path %load-path "guix.scm"))
- ("p/z" . ,(search-path %load-path "guix/store.scm"))))
- (drv (imported-files %store files)))
- (and (build-derivations %store (list drv))
- (let ((dir (derivation->output-path drv)))
- (every (match-lambda
- ((path . source)
- (equal? (call-with-input-file (string-append dir "/" path)
- get-bytevector-all)
- (call-with-input-file source
- get-bytevector-all))))
- files)))))
-
(test-assert "build-expression->derivation with modules"
(let* ((builder `(begin
(use-modules (guix build utils))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 03722e4669..0b189b570b 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -249,6 +249,23 @@
(equal? refs (list (dirname (dirname guile))))
(equal? refs2 (list file))))))
+(test-assertm "gexp->derivation vs. grafts"
+ (mlet* %store-monad ((p0 -> (dummy-package "dummy"
+ (arguments
+ '(#:implicit-inputs? #f))))
+ (r -> (package (inherit p0) (name "DuMMY")))
+ (p1 -> (package (inherit p0) (replacement r)))
+ (exp0 -> (gexp (frob (ungexp p0) (ungexp output))))
+ (exp1 -> (gexp (frob (ungexp p1) (ungexp output))))
+ (void (set-guile-for-build %bootstrap-guile))
+ (drv0 (gexp->derivation "t" exp0))
+ (drv1 (gexp->derivation "t" exp1))
+ (drv1* (gexp->derivation "t" exp1 #:graft? #f)))
+ (return (and (not (string=? (derivation->output-path drv0)
+ (derivation->output-path drv1)))
+ (string=? (derivation->output-path drv0)
+ (derivation->output-path drv1*))))))
+
(test-assertm "gexp->derivation, composed gexps"
(mlet* %store-monad ((exp0 -> (gexp (begin
(mkdir (ungexp output))
@@ -360,6 +377,40 @@
(string=? (readlink (string-append out "/" two "/one"))
one)))))))
+(test-assertm "imported-files"
+ (mlet* %store-monad
+ ((files -> `(("x" . ,(search-path %load-path "ice-9/q.scm"))
+ ("a/b/c" . ,(search-path %load-path
+ "guix/derivations.scm"))
+ ("p/q" . ,(search-path %load-path "guix.scm"))
+ ("p/z" . ,(search-path %load-path "guix/store.scm"))))
+ (drv (imported-files files)))
+ (mbegin %store-monad
+ (built-derivations (list drv))
+ (let ((dir (derivation->output-path drv)))
+ (return
+ (every (match-lambda
+ ((path . source)
+ (equal? (call-with-input-file (string-append dir "/" path)
+ get-bytevector-all)
+ (call-with-input-file source
+ get-bytevector-all))))
+ files))))))
+
+(test-assertm "gexp->derivation #:modules"
+ (mlet* %store-monad
+ ((build -> #~(begin
+ (use-modules (guix build utils))
+ (mkdir-p (string-append #$output "/guile/guix/nix"))
+ #t))
+ (drv (gexp->derivation "test-with-modules" build
+ #:modules '((guix build utils)))))
+ (mbegin %store-monad
+ (built-derivations (list drv))
+ (let* ((p (derivation->output-path drv))
+ (s (stat (string-append p "/guile/guix/nix"))))
+ (return (eq? (stat:type s) 'directory))))))
+
(test-assertm "gexp->derivation #:references-graphs"
(mlet* %store-monad
((one (text-file "one" "hello, world"))
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index d4917bbf90..94cf927420 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -28,6 +28,14 @@ readlink_base ()
basename `readlink "$1"`
}
+# Return true if a typical shebang in the store would not exceed Linux's
+# default static limit.
+shebang_not_too_long ()
+{
+ test `echo $NIX_STORE_DIR/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-bootstrap-binaries-0/bin/bash | wc -c` \
+ -lt 128
+}
+
module_dir="t-guix-package-$$"
profile="t-profile-$$"
rm -f "$profile"
@@ -55,8 +63,9 @@ test -f "$profile/bin/guile"
guix package --search-paths -p "$profile"
test "`guix package --search-paths -p "$profile" | wc -l`" = 0
-# Check whether we have network access.
-if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
+# Check whether we have network access and an acceptable shebang length.
+if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null \
+ && shebang_not_too_long
then
boot_make="(@@ (gnu packages commencement) gnu-make-boot0)"
boot_make_drv="`guix build -e "$boot_make" | grep -v -e -debug`"
diff --git a/tests/packages.scm b/tests/packages.scm
index 851520b343..d6371b3b49 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,7 +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))
+(when (or (not (network-reachable?)) (shebang-too-long?))
(test-skip 1))
(test-assert "GNU Make, bootstrap"
;; GNU Make is the first program built during bootstrap; we choose it
diff --git a/tests/ui.scm b/tests/ui.scm
index 25fc709431..1478fe213e 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -22,6 +22,8 @@
#:use-module (guix profiles)
#:use-module (guix store)
#:use-module (guix derivations)
+ #:use-module ((guix scripts build)
+ #:select (%standard-build-options))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
@@ -52,9 +54,43 @@ interface, and powerful string processing.")
(item "/gnu/store/...")
(output "out")))
+(define-syntax-rule (with-environment-variable variable value body ...)
+ "Run BODY with VARIABLE set to VALUE."
+ (let ((orig (getenv variable)))
+ (dynamic-wind
+ (lambda ()
+ (setenv variable value))
+ (lambda ()
+ body ...)
+ (lambda ()
+ (if orig
+ (setenv variable orig)
+ (unsetenv variable))))))
+
(test-begin "ui")
+(test-equal "parse-command-line"
+ '((argument . "bar") (argument . "foo")
+ (cores . 10) ;takes precedence
+ (substitutes? . #f) (keep-failed? . #t)
+ (max-jobs . 77) (cores . 42))
+
+ (with-environment-variable "GUIX_BUILD_OPTIONS" "-c 42 -M 77"
+ (parse-command-line '("--keep-failed" "--no-substitutes"
+ "--cores=10" "foo" "bar")
+ %standard-build-options
+ (list '()))))
+
+(test-equal "parse-command-line and --no options"
+ '((argument . "foo")
+ (substitutes? . #f)) ;takes precedence
+
+ (with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes"
+ (parse-command-line '("foo")
+ %standard-build-options
+ (list '((substitutes? . #t))))))
+
(test-assert "fill-paragraph"
(every (lambda (column)
(every (lambda (width)
@@ -246,3 +282,7 @@ Second line" 24))
(exit (= (test-runner-fail-count (test-runner-current)) 0))
+
+;;; Local Variables:
+;;; eval: (put 'with-environment-variable 'scheme-indent-function 2)
+;;; End:
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))
generated by cgit v1.2.3 (git 2.45.0) at 2024-12-16 11:33:00 +0000