diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/builders.scm | 8 | ||||
| -rw-r--r-- | tests/cpan.scm | 14 | ||||
| -rw-r--r-- | tests/derivations.scm | 19 | ||||
| -rw-r--r-- | tests/gexp.scm | 51 | ||||
| -rw-r--r-- | tests/guix-package.sh | 13 | ||||
| -rw-r--r-- | tests/packages.scm | 5 | ||||
| -rw-r--r-- | tests/ui.scm | 40 | ||||
| -rw-r--r-- | tests/union.scm | 6 |
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)) |