diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/channels.scm | 104 | ||||
| -rw-r--r-- | tests/containers.scm | 27 | ||||
| -rw-r--r-- | tests/gexp.scm | 7 | ||||
| -rw-r--r-- | tests/git.scm | 99 | ||||
| -rw-r--r-- | tests/guix-environment-container.sh | 5 | ||||
| -rw-r--r-- | tests/guix-package-aliases.sh | 7 | ||||
| -rw-r--r-- | tests/guix-package.sh | 17 | ||||
| -rw-r--r-- | tests/inferior.scm | 13 | ||||
| -rw-r--r-- | tests/syscalls.scm | 13 | ||||
| -rw-r--r-- | tests/ui.scm | 5 |
10 files changed, 295 insertions, 2 deletions
diff --git a/tests/channels.scm b/tests/channels.scm index e83b5437d3..f5a7955483 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -28,6 +28,10 @@ #:use-module (guix gexp) #:use-module ((guix utils) #:select (error-location? error-location location-line)) + #:use-module ((guix build utils) #:select (which)) + #:use-module (git) + #:use-module (guix git) + #:use-module (guix tests git) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) @@ -246,4 +250,104 @@ (depends? drv3 (list drv2 drv0) (list)))))))) +(unless (which (git-command)) (test-skip 1)) +(test-equal "channel-news, no news" + '() + (with-temporary-git-repository directory + '((add "a.txt" "A") + (commit "the commit")) + (with-repository directory repository + (let ((channel (channel (url (string-append "file://" directory)) + (name 'foo))) + (latest (reference-name->oid repository "HEAD"))) + (channel-news-for-commit channel (oid->string latest)))))) + +(unless (which (git-command)) (test-skip 1)) +(test-assert "channel-news, one entry" + (with-temporary-git-repository directory + `((add ".guix-channel" + ,(object->string + '(channel (version 0) + (news-file "news.scm")))) + (commit "first commit") + (add "src/a.txt" "A") + (commit "second commit") + (tag "tag-for-first-news-entry") + (add "news.scm" + ,(lambda (repository) + (let ((previous + (reference-name->oid repository "HEAD"))) + (object->string + `(channel-news + (version 0) + (entry (commit ,(oid->string previous)) + (title (en "New file!") + (eo "Nova dosiero!")) + (body (en "Yeah, a.txt.")))))))) + (commit "third commit") + (add "src/b.txt" "B") + (commit "fourth commit") + (add "news.scm" + ,(lambda (repository) + (let ((second + (commit-id + (find-commit repository "second commit"))) + (previous + (reference-name->oid repository "HEAD"))) + (object->string + `(channel-news + (version 0) + (entry (commit ,(oid->string previous)) + (title (en "Another file!")) + (body (en "Yeah, b.txt."))) + (entry (tag "tag-for-first-news-entry") + (title (en "Old news.") + (eo "Malnovaĵoj.")) + (body (en "For a.txt")))))))) + (commit "fifth commit")) + (with-repository directory repository + (define (find-commit* message) + (oid->string (commit-id (find-commit repository message)))) + + (let ((channel (channel (url (string-append "file://" directory)) + (name 'foo))) + (commit1 (find-commit* "first commit")) + (commit2 (find-commit* "second commit")) + (commit3 (find-commit* "third commit")) + (commit4 (find-commit* "fourth commit")) + (commit5 (find-commit* "fifth commit"))) + ;; First try fetching all the news up to a given commit. + (and (null? (channel-news-for-commit channel commit2)) + (lset= string=? + (map channel-news-entry-commit + (channel-news-for-commit channel commit5)) + (list commit2 commit4)) + (lset= equal? + (map channel-news-entry-title + (channel-news-for-commit channel commit5)) + '((("en" . "Another file!")) + (("en" . "Old news.") ("eo" . "Malnovaĵoj.")))) + (lset= string=? + (map channel-news-entry-commit + (channel-news-for-commit channel commit3)) + (list commit2)) + + ;; Now fetch news entries that apply to a commit range. + (lset= string=? + (map channel-news-entry-commit + (channel-news-for-commit channel commit3 commit1)) + (list commit2)) + (lset= string=? + (map channel-news-entry-commit + (channel-news-for-commit channel commit5 commit3)) + (list commit4)) + (lset= string=? + (map channel-news-entry-commit + (channel-news-for-commit channel commit5 commit1)) + (list commit4 commit2)) + (lset= equal? + (map channel-news-entry-tag + (channel-news-for-commit channel commit5 commit1)) + '(#f "tag-for-first-news-entry"))))))) + (test-end "channels") diff --git a/tests/containers.scm b/tests/containers.scm index c6c738f234..01fbcbb45a 100644 --- a/tests/containers.scm +++ b/tests/containers.scm @@ -269,4 +269,31 @@ (lset= string=? (cons* "." ".." (map basename reqs)) (pk (call-with-input-file result read)))))))))) +(test-assert "eval/container, non-empty load path" + (call-with-temporary-directory + (lambda (directory) + (define store + (open-connection-for-tests)) + (define result + (string-append directory "/r")) + (define requisites* + (store-lift requisites)) + + (mkdir result) + (run-with-store store + (mlet %store-monad ((status (eval/container + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (mkdir-p "/result/a/b/c"))) + #:mappings + (list (file-system-mapping + (source result) + (target "/result") + (writable? #t)))))) + (close-connection store) + (return (and (zero? status) + (file-is-directory? + (string-append result "/a/b/c"))))))))) + (test-end) diff --git a/tests/gexp.scm b/tests/gexp.scm index 5c013d838d..50d0948659 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -871,6 +871,13 @@ (eq? (derivation-input-derivation (lowered-gexp-guile lexp)) (%guile-for-build))))))) +(test-eq "lower-gexp, non-self-quoting input" + + + (guard (c ((gexp-input-error? c) + (gexp-error-invalid-input c))) + (run-with-store %store + (lower-gexp #~(foo #$+))))) + (test-assertm "gexp->derivation #:references-graphs" (mlet* %store-monad ((one (text-file "one" (random-text))) diff --git a/tests/git.scm b/tests/git.scm new file mode 100644 index 0000000000..8ba10ece51 --- /dev/null +++ b/tests/git.scm @@ -0,0 +1,99 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 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-git) + #:use-module (git) + #:use-module (guix git) + #:use-module (guix tests git) + #:use-module (guix build utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64)) + +;; Test the (guix git) tools. + +(test-begin "git") + +;; 'with-temporary-git-repository' relies on the 'git' command. +(unless (which (git-command)) (test-skip 1)) +(test-assert "commit-difference, linear history" + (with-temporary-git-repository directory + '((add "a.txt" "A") + (commit "first commit") + (add "b.txt" "B") + (commit "second commit") + (add "c.txt" "C") + (commit "third commit") + (add "d.txt" "D") + (commit "fourth commit")) + (with-repository directory repository + (let ((commit1 (find-commit repository "first")) + (commit2 (find-commit repository "second")) + (commit3 (find-commit repository "third")) + (commit4 (find-commit repository "fourth"))) + (and (lset= eq? (commit-difference commit4 commit1) + (list commit2 commit3 commit4)) + (lset= eq? (commit-difference commit4 commit2) + (list commit3 commit4)) + (equal? (commit-difference commit3 commit2) + (list commit3)) + + ;; COMMIT4 is not an ancestor of COMMIT1 so we should get the + ;; empty list. + (null? (commit-difference commit1 commit4))))))) + +(unless (which (git-command)) (test-skip 1)) +(test-assert "commit-difference, fork" + (with-temporary-git-repository directory + '((add "a.txt" "A") + (commit "first commit") + (branch "devel") + (checkout "devel") + (add "devel/1.txt" "1") + (commit "first devel commit") + (add "devel/2.txt" "2") + (commit "second devel commit") + (checkout "master") + (add "b.txt" "B") + (commit "second commit") + (add "c.txt" "C") + (commit "third commit") + (merge "devel" "merge") + (add "d.txt" "D") + (commit "fourth commit")) + (with-repository directory repository + (let ((master1 (find-commit repository "first commit")) + (master2 (find-commit repository "second commit")) + (master3 (find-commit repository "third commit")) + (master4 (find-commit repository "fourth commit")) + (devel1 (find-commit repository "first devel")) + (devel2 (find-commit repository "second devel")) + (merge (find-commit repository "merge"))) + (and (equal? (commit-difference master4 merge) + (list master4)) + (lset= eq? (commit-difference master3 master1) + (list master3 master2)) + (lset= eq? (commit-difference devel2 master1) + (list devel2 devel1)) + + ;; The merge occurred between MASTER2 and MASTER4 so here we + ;; expect to see all the commits from the "devel" branch in + ;; addition to those on "master". + (lset= eq? (commit-difference master4 master2) + (list master4 merge master3 devel1 devel2))))))) + +(test-end "git") diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh index 32a5ba1f97..d313f2e734 100644 --- a/tests/guix-environment-container.sh +++ b/tests/guix-environment-container.sh @@ -44,6 +44,11 @@ else test $? = 42 fi +# Make sure '--preserve' is honored. +result="`FOOBAR=42; export FOOBAR; guix environment -C --ad-hoc --bootstrap \ + guile-bootstrap -E ^FOO -- guile -c '(display (getenv \"FOOBAR\"))'`" +test "$result" = "42" + # By default, the UID inside the container should be the same as outside. uid="`id -u`" inner_uid="`guix environment -C --ad-hoc --bootstrap guile-bootstrap \ diff --git a/tests/guix-package-aliases.sh b/tests/guix-package-aliases.sh index 5c68664093..4beed2e5b7 100644 --- a/tests/guix-package-aliases.sh +++ b/tests/guix-package-aliases.sh @@ -58,3 +58,10 @@ if guix remove -i guile-bootstrap -p "$profile" --bootstrap then false; else true; fi guix search '\<board\>' game | grep '^name: gnubg' + +guix show --version +guix show guile +guix show python@3 | grep "^name: python" + +# "python@2" exists but is deprecated; make sure it doesn't show up. +if guix show python@2; then false; else true; fi diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 79d6ec65e4..0de30bf6c1 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -331,6 +331,17 @@ cat > "$module_dir/package.scm"<<EOF EOF guix package --bootstrap --install-from-file="$module_dir/package.scm" +# Make sure an error is raised if the file doesn't return a package. +cat > "$module_dir/package.scm"<<EOF +(use-modules (gnu packages base)) + +(define my-package coreutils) ;returns *unspecified* +EOF +if guix package --bootstrap --install-from-file="$module_dir/package.scm" +then false; else true; fi + +rm "$module_dir/package.scm" + # This one should not show up in searches since it's no supported on the # current system. test "`guix package -A super-non-portable-emacs`" = "" @@ -427,7 +438,7 @@ cat > "$module_dir/foo.scm"<<EOF (version "dummy-version") (outputs '("out" "dummy-output")) (source #f) - ;; Without a real build system, the "guix pacakge -s" command will fail. + ;; Without a real build system, the "guix package -s" command will fail. (build-system trivial-build-system) (synopsis "dummy-synopsis") (description "dummy-description") @@ -437,3 +448,7 @@ EOF guix package -L "$module_dir" -s dummy-output > /tmp/out test "`guix package -L "$module_dir" -s dummy-output | grep ^name:`" = "name: dummy-package" rm -rf "$module_dir" + +# Make sure we can see user profiles. +guix package --list-profiles | grep "$profile" +guix package --list-profiles | grep '\.guix-profile' diff --git a/tests/inferior.scm b/tests/inferior.scm index 71ebf8f59b..f54b6d6037 100644 --- a/tests/inferior.scm +++ b/tests/inferior.scm @@ -27,6 +27,7 @@ #:use-module (gnu packages bootstrap) #:use-module (gnu packages guile) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) #:use-module (srfi srfi-64) #:use-module (ice-9 match)) @@ -186,6 +187,18 @@ (add-text-to-store store "foo" "Hello, world!"))))) +(test-assert "inferior-eval-with-store, &store-protocol-error" + (let* ((inferior (open-inferior %top-builddir + #:command "scripts/guix"))) + (guard (c ((store-protocol-error? c) + (string-contains (store-protocol-error-message c) + "invalid character"))) + (inferior-eval-with-store inferior %store + '(lambda (store) + (add-text-to-store store "we|rd/?!@" + "uh uh"))) + #f))) + (test-equal "inferior-package-derivation" (map derivation-file-name (list (package-derivation %store %bootstrap-guile "x86_64-linux") diff --git a/tests/syscalls.scm b/tests/syscalls.scm index eeb223b950..1b3121e503 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -567,6 +567,19 @@ (let ((result (call-with-input-file "/var/run/utmpx" read-utmpx))) (or (utmpx? result) (eof-object? result)))) +(when (zero? (getuid)) + (test-skip 1)) +(test-equal "add-to-entropy-count" + EPERM + (call-with-output-file "/dev/urandom" + (lambda (port) + (catch 'system-error + (lambda () + (add-to-entropy-count port 77) + #f) + (lambda args + (system-error-errno args)))))) + (test-end) (false-if-exception (delete-file temp-file)) diff --git a/tests/ui.scm b/tests/ui.scm index 2138e23369..d8573e88d8 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -267,6 +267,7 @@ Second line" 24)) (gcrypt (specification->package "guile-gcrypt")) (go (specification->package "go")) (gnugo (specification->package "gnugo")) + (libb2 (specification->package "libb2")) (rx (cut make-regexp <> regexp/icase)) (>0 (cut > <> 0)) (=0 zero?)) @@ -283,6 +284,8 @@ Second line" 24)) (=0 (package-relevance go (map rx '("go" "game")))) (>0 (package-relevance gnugo - (map rx '("go" "game"))))))) + (map rx '("go" "game")))) + (>0 (package-relevance libb2 + (map rx '("crypto" "library"))))))) (test-end "ui") |