aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/glob.scm58
-rw-r--r--tests/guix-build.sh2
-rw-r--r--tests/guix-environment-container.sh25
-rw-r--r--tests/guix-package.sh18
-rw-r--r--tests/hash.scm19
-rw-r--r--tests/packages.scm20
-rw-r--r--tests/profiles.scm7
7 files changed, 135 insertions, 14 deletions
diff --git a/tests/glob.scm b/tests/glob.scm
new file mode 100644
index 0000000000..033eeb10fe
--- /dev/null
+++ b/tests/glob.scm
@@ -0,0 +1,58 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 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-glob)
+ #:use-module (guix glob)
+ #:use-module (srfi srfi-64))
+
+
+(test-begin "glob")
+
+(test-equal "compile-glob-pattern, no wildcards"
+ "foo"
+ (compile-glob-pattern "foo"))
+
+(test-equal "compile-glob-pattern, Kleene star"
+ '("foo" * "bar")
+ (compile-glob-pattern "foo*bar"))
+
+(test-equal "compile-glob-pattern, question mark"
+ '(? "foo" *)
+ (compile-glob-pattern "?foo*"))
+
+(test-assert "literal match"
+ (let ((pattern (compile-glob-pattern "foo")))
+ (and (glob-match? pattern "foo")
+ (not (glob-match? pattern "foobar"))
+ (not (glob-match? pattern "barfoo")))))
+
+(test-assert "trailing star"
+ (let ((pattern (compile-glob-pattern "foo*")))
+ (and (glob-match? pattern "foo")
+ (glob-match? pattern "foobar")
+ (not (glob-match? pattern "xfoo")))))
+
+(test-assert "question marks"
+ (let ((pattern (compile-glob-pattern "foo??bar")))
+ (and (glob-match? pattern "fooxxbar")
+ (glob-match? pattern "fooZZbar")
+ (not (glob-match? pattern "foobar"))
+ (not (glob-match? pattern "fooxxxbar"))
+ (not (glob-match? pattern "fooxxbarzz")))))
+
+(test-end "glob")
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index 004a40dee2..b84723fa43 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -184,7 +184,7 @@ test "`guix build superseded -d`" = "`guix build bar -d`"
# Parsing package names and versions.
guix build -n time # PASS
-guix build -n time@1.8 # PASS, version found
+guix build -n time@1.9 # PASS, version found
if guix build -n time@3.2; # FAIL, version not found
then false; else true; fi
if guix build -n something-that-will-never-exist; # FAIL
diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh
index d7c1b7057e..a2da9a0773 100644
--- a/tests/guix-environment-container.sh
+++ b/tests/guix-environment-container.sh
@@ -97,6 +97,31 @@ grep -e "$NIX_STORE_DIR/.*-bash" $tmpdir/mounts # bootstrap bash
rm $tmpdir/mounts
+# Make sure 'GUIX_ENVIRONMENT' is linked to '~/.guix-profile' when requested
+# within a container.
+(
+ linktest='(exit (string=? (getenv "GUIX_ENVIRONMENT")
+(readlink (string-append (getenv "HOME") "/.guix-profile"))))'
+
+ cd "$tmpdir" \
+ && guix environment --bootstrap --container --link-profile \
+ --ad-hoc guile-bootstrap --pure \
+ -- guile -c "$linktest"
+)
+
+# Test that user can be mocked.
+usertest='(exit (and (string=? (getenv "HOME") "/home/foognu")
+ (string=? (passwd:name (getpwuid 0)) "foognu")
+ (file-exists? "/home/foognu/umock")))'
+touch "$tmpdir/umock"
+HOME="$tmpdir" guix environment --bootstrap --container --user=foognu \
+ --ad-hoc guile-bootstrap --pure \
+ --share="$tmpdir/umock" \
+ -- guile -c "$usertest"
+
+
+# Check the exit code.
+
abnormal_exit_code="
(use-modules (system foreign))
;; Purposely make Guile crash with a segfault. :)
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index ffc8c64e24..760a2e4c9b 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
#
# This file is part of GNU Guix.
@@ -118,6 +118,22 @@ grep '^name: gnubg' "$tmpfile"
rm -f "$tmpfile"
+# Make sure deprecated packages don't show up: <https://bugs.gnu.org/30566>.
+mkdir "$module_dir"
+cat > "$module_dir/foo.scm"<<EOF
+(define-module (foo)
+ #:use-module (guix packages)
+ #:use-module (gnu packages base))
+
+(define-public deprecated
+ (deprecated-package "fileutils" coreutils))
+EOF
+
+guix build -L "$module_dir" -e '(@ (foo) deprecated)' -n
+test "`guix package -L "$module_dir" -s ^fileutils$ | grep ^name:`" = ""
+
+rm -rf "$module_dir"
+
# Make sure `--search' can display all the packages.
guix package --search="" > /dev/null
diff --git a/tests/hash.scm b/tests/hash.scm
index b189e435c8..da87616eec 100644
--- a/tests/hash.scm
+++ b/tests/hash.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -37,16 +37,17 @@
(base16-string->bytevector
"b94d27b9934d3e08a52e52d7da7dabfac484efe37a5380ee9088f7ace2efcde9"))
-(define (supports-unbuffered-cbip?)
- "Return #t if unbuffered custom binary input ports (CBIPs) are supported.
-In Guile <= 2.0.9, CBIPs were always fully buffered, so the
-'open-sha256-input-port' does not work there."
- (false-if-exception
- (setvbuf (make-custom-binary-input-port "foo" pk #f #f #f) _IONBF)))
-
(test-begin "hash")
+(test-equal "sha1, empty"
+ (base16-string->bytevector "da39a3ee5e6b4b0d3255bfef95601890afd80709")
+ (sha1 #vu8()))
+
+(test-equal "sha1, hello"
+ (base16-string->bytevector "2aae6c35c94fcfb415dbe95f408b9ce91ee846ed")
+ (sha1 (string->utf8 "hello world")))
+
(test-equal "sha256, empty"
%empty-sha256
(sha256 #vu8()))
@@ -77,8 +78,6 @@ In Guile <= 2.0.9, CBIPs were always fully buffered, so the
(equal? (sha256 contents)
(call-with-input-file file port-sha256))))
-(test-skip (if (supports-unbuffered-cbip?) 0 4))
-
(test-equal "open-sha256-input-port, empty"
`("" ,%empty-sha256)
(let-values (((port get)
diff --git a/tests/packages.scm b/tests/packages.scm
index 930374dabf..b2fa21a874 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -557,6 +557,24 @@
(let ((p (pk 'drv d (derivation->output-path d))))
(eq? 'hello (call-with-input-file p read))))))
+(test-assert "trivial with #:allowed-references"
+ (let* ((p (package
+ (inherit (dummy-package "trivial"))
+ (build-system trivial-build-system)
+ (arguments
+ `(#:guile ,%bootstrap-guile
+ #:allowed-references (,%bootstrap-guile)
+ #:builder
+ (begin
+ (mkdir %output)
+ ;; The reference to itself isn't allowed so building it
+ ;; should fail.
+ (symlink %output (string-append %output "/self")))))))
+ (d (package-derivation %store p)))
+ (guard (c ((nix-protocol-error? c) #t))
+ (build-derivations %store (list d))
+ #f)))
+
(test-assert "search paths"
(let* ((p (make-prompt-tag "return-search-paths"))
(s (build-system
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 469dde2652..92eb08cb9e 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -148,6 +148,11 @@
(_ #f))
(equal? m3 m4))))
+(test-equal "manifest-add removes duplicates" ;<https://bugs.gnu.org/30569>
+ (list guile-2.0.9)
+ (manifest-entries (manifest-add (manifest '())
+ (list guile-2.0.9 guile-2.0.9))))
+
(test-assert "manifest-perform-transaction"
(let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
(t1 (manifest-transaction
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-15 12:17:34 +0000