Merge branch 'master' into core-updates

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