diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/cache.scm | 88 | ||||
| -rw-r--r-- | tests/derivations.scm | 14 | ||||
| -rw-r--r-- | tests/gexp.scm | 4 | ||||
| -rw-r--r-- | tests/guix-build.sh | 8 | ||||
| -rw-r--r-- | tests/publish.scm | 54 | ||||
| -rw-r--r-- | tests/scripts-build.scm | 7 | ||||
| -rw-r--r-- | tests/store.scm | 8 | ||||
| -rw-r--r-- | tests/workers.scm | 45 |
8 files changed, 225 insertions, 3 deletions
diff --git a/tests/cache.scm b/tests/cache.scm new file mode 100644 index 0000000000..e46cdd816d --- /dev/null +++ b/tests/cache.scm @@ -0,0 +1,88 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (test-cache) + #:use-module (guix cache) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-64) + #:use-module ((guix utils) #:select (call-with-temporary-directory)) + #:use-module (ice-9 match)) + +(cond-expand + (guile-2.2 + ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and + ;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it. + (define time-monotonic time-tai)) + (else #t)) + +(test-begin "cache") + +(test-equal "remove-expired-cache-entries" + '("o" "l" "d") + (let* ((removed '()) + (now (time-second (current-time time-monotonic))) + (ttl 100) + (stamp (match-lambda + ((or "n" "e" "w") (+ now 100)) + ((or "o" "l" "d") (- now 100)))) + (delete (lambda (entry) + (set! removed (cons entry removed))))) + (remove-expired-cache-entries (reverse '("n" "e" "w" + "o" "l" "d")) + #:entry-expiration stamp + #:delete-entry delete) + removed)) + +(define-syntax-rule (test-cache-cleanup cache exp ...) + (call-with-temporary-directory + (lambda (cache) + (let* ((deleted '()) + (delete! (lambda (entry) + (set! deleted (cons entry deleted))))) + exp ... + (maybe-remove-expired-cache-entries cache + (const '("a" "b" "c")) + #:entry-expiration (const 0) + #:delete-entry delete!) + (reverse deleted))))) + +(test-equal "maybe-remove-expired-cache-entries, first cleanup" + '("a" "b" "c") + (test-cache-cleanup cache)) + +(test-equal "maybe-remove-expired-cache-entries, no cleanup needed" + '() + (test-cache-cleanup cache + (call-with-output-file (string-append cache "/last-expiry-cleanup") + (lambda (port) + (display (+ (time-second (current-time time-monotonic)) 100) + port))))) + +(test-equal "maybe-remove-expired-cache-entries, cleanup needed" + '("a" "b" "c") + (test-cache-cleanup cache + (call-with-output-file (string-append cache "/last-expiry-cleanup") + (lambda (port) + (display 0 port))))) + +(test-end "cache") + +;;; Local Variables: +;;; eval: (put 'test-cache-cleanup 'scheme-indent-function 1) +;;; End: diff --git a/tests/derivations.scm b/tests/derivations.scm index 75c8d1dfb1..cabbf7b951 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -701,6 +701,20 @@ #:modules '((guix module that does not exist))))) +(test-equal "build-expression->derivation and builder encoding" + '("UTF-8" #t) + (let* ((exp '(λ (α) (+ α 1))) + (drv (build-expression->derivation %store "foo" exp))) + (match (derivation-builder-arguments drv) + ((... builder) + (with-fluids ((%default-port-encoding "UTF-8")) + (call-with-input-file builder + (lambda (port) + (list (port-encoding port) + (->bool + (string-contains (get-string-all port) + "(λ (α) (+ α 1))")))))))))) + (test-assert "build-expression->derivation and derivation-prerequisites" (let ((drv (build-expression->derivation %store "fail" #f))) (any (match-lambda diff --git a/tests/gexp.scm b/tests/gexp.scm index 41a53ae5a4..cf88a9db80 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -627,6 +627,10 @@ #~(foo #$@(list (with-imported-modules '((foo)) #~+) (with-imported-modules '((bar)) #~-))))) +(test-equal "gexp-modules and literal Scheme object" + '() + (gexp-modules #t)) + (test-assertm "gexp->derivation #:modules" (mlet* %store-monad ((build -> #~(begin diff --git a/tests/guix-build.sh b/tests/guix-build.sh index ab911b7210..9494e7371f 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -36,6 +36,14 @@ guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' | \ guix build hello -d | \ grep -e '-hello-[0-9\.]\+\.drv$' +# Passing a URI. +GUIX_DAEMON_SOCKET="file://$NIX_STATE_DIR/daemon-socket/socket" \ +guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)' + +( if GUIX_DAEMON_SOCKET="weird://uri" \ + guix build -e '(@@ (gnu packages bootstrap) %bootstrap-guile)'; \ + then exit 1; fi ) + # Check --sources option with its arguments module_dir="t-guix-build-$$" mkdir "$module_dir" diff --git a/tests/publish.scm b/tests/publish.scm index ea0f4a3477..233b71ce93 100644 --- a/tests/publish.scm +++ b/tests/publish.scm @@ -314,4 +314,58 @@ References: ~%" (call-with-input-string "" port-sha256)))))) (response-code (http-get uri)))) +(unless (zlib-available?) + (test-skip 1)) +(test-equal "with cache" + (list #t + `(("StorePath" . ,%item) + ("URL" . ,(string-append "nar/gzip/" (basename %item))) + ("Compression" . "gzip")) + 200 ;nar/gzip/… + #t ;Content-Length + 200) ;nar/… + (call-with-temporary-directory + (lambda (cache) + (define (wait-for-file file) + (let loop ((i 20)) + (or (file-exists? file) + (begin + (pk 'wait-for-file file) + (sleep 1) + (loop (- i 1)))))) + + (let ((thread (with-separate-output-ports + (call-with-new-thread + (lambda () + (guix-publish "--port=6797" "-C2" + (string-append "--cache=" cache))))))) + (wait-until-ready 6797) + (let* ((base "http://localhost:6797/") + (part (store-path-hash-part %item)) + (url (string-append base part ".narinfo")) + (nar-url (string-append base "/nar/gzip/" (basename %item))) + (cached (string-append cache "/gzip/" (basename %item) + ".narinfo")) + (nar (string-append cache "/gzip/" + (basename %item) ".nar")) + (response (http-get url))) + (and (= 404 (response-code response)) + (wait-for-file cached) + (let ((body (http-get-port url)) + (compressed (http-get nar-url)) + (uncompressed (http-get (string-append base "nar/" + (basename %item))))) + (list (file-exists? nar) + (filter (lambda (item) + (match item + (("Compression" . _) #t) + (("StorePath" . _) #t) + (("URL" . _) #t) + (_ #f))) + (recutils->alist body)) + (response-code compressed) + (= (response-content-length compressed) + (stat:size (stat nar))) + (response-code uncompressed))))))))) + (test-end "publish") diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm index a1f684c736..a408ea6f8d 100644 --- a/tests/scripts-build.scm +++ b/tests/scripts-build.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,6 +23,7 @@ #:use-module (guix scripts build) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (gnu packages) #:use-module (gnu packages base) #:use-module (gnu packages busybox) #:use-module (ice-9 match) @@ -97,8 +98,8 @@ (test-assert "options->transformation, with-input" (let* ((p (dummy-package "guix.scm" - (inputs `(("foo" ,coreutils) - ("bar" ,grep) + (inputs `(("foo" ,(specification->package "coreutils")) + ("bar" ,(specification->package "grep")) ("baz" ,(dummy-package "chbouib" (native-inputs `(("x" ,grep))))))))) (t (options->transformation '((with-input . "coreutils=busybox") diff --git a/tests/store.scm b/tests/store.scm index 45150d36ca..3eb8b7be5a 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -48,6 +48,14 @@ (test-begin "store") +(test-assert "open-connection with file:// URI" + (let ((store (open-connection (string-append "file://" + (%daemon-socket-uri))))) + (and (add-text-to-store store "foo" "bar") + (begin + (close-connection store) + #t)))) + (test-equal "connection handshake error" EPROTO (let ((port (%make-void-port "rw"))) diff --git a/tests/workers.scm b/tests/workers.scm new file mode 100644 index 0000000000..44b882f691 --- /dev/null +++ b/tests/workers.scm @@ -0,0 +1,45 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (test-workers) + #:use-module (guix workers) + #:use-module (ice-9 threads) + #:use-module (srfi srfi-64)) + +(test-begin "workers") + +(test-equal "enqueue" + 4242 + (let* ((pool (make-pool)) + (result 0) + (1+! (let ((lock (make-mutex))) + (lambda () + (with-mutex lock + (set! result (+ result 1))))))) + (let loop ((i 4242)) + (unless (zero? i) + (pool-enqueue! pool 1+!) + (loop (- i 1)))) + (let poll () + (unless (pool-idle? pool) + (pk 'busy result) + (sleep 1) + (poll))) + result)) + +(test-end) |