Merge remote-tracking branch 'origin/master' into core-updates-frozen

9 files changed, 402 insertions, 0 deletions

diff --git a/tests/guix-environment-container.sh b/tests/guix-environment-container.sh
index f2d15c8d0c..2e238c501d 100644
--- a/tests/guix-environment-container.sh
+++ b/tests/guix-environment-container.sh
@@ -44,6 +44,14 @@ else
     test $? = 42
 fi
 
+# Try '--root' and '--profile'.
+root="$tmpdir/root"
+guix environment -C --ad-hoc --bootstrap guile-bootstrap -r "$root" -- guile --version
+guix environment -C -p "$root" --bootstrap -- guile --version
+path1=$(guix environment -C -p "$root" --bootstrap -- guile -c '(display (getenv "PATH"))')
+path2=$(guix environment -C --ad-hoc --bootstrap guile-bootstrap  -- guile -c '(display (getenv "PATH"))')
+test "$path1" = "$path2"
+
 # Make sure "localhost" resolves.
 guix environment --container --ad-hoc --bootstrap guile-bootstrap \
      -- guile -c '(exit (pair? (getaddrinfo "localhost" "80")))'
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index fe2430b658..95fe95b437 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -119,6 +119,13 @@ test `readlink "$gcroot"` = "$expected"
 guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
      -- guile -c 1
 test `readlink "$gcroot"` = "$expected"
+
+# Make sure '-p' works as expected.
+test $(guix environment -p "$gcroot" -- "$SHELL" -c 'echo $GUIX_ENVIRONMENT') = "$expected"
+paths1="$(guix environment -p "$gcroot" --search-paths)"
+paths2="$(guix environment --bootstrap --ad-hoc guile-bootstrap --search-paths)"
+test "$paths1" = "$paths2"
+
 rm "$gcroot"
 
 # Try '-r' with a relative file name.
diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh
new file mode 100644
index 0000000000..3bdf625189
--- /dev/null
+++ b/tests/guix-shell.sh
@@ -0,0 +1,102 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2021 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/>.
+
+#
+# Test the 'guix shell' alias.
+#
+
+guix shell --version
+
+configdir="t-guix-shell-config-$$"
+tmpdir="t-guix-shell-$$"
+trap 'rm -r "$tmpdir" "$configdir"' EXIT
+mkdir "$tmpdir" "$configdir" "$configdir/guix"
+
+XDG_CONFIG_HOME="$(realpath $configdir)"
+export XDG_CONFIG_HOME
+
+guix shell --bootstrap --pure guile-bootstrap -- guile --version
+
+# '--ad-hoc' is a thing of the past.
+! guix shell --ad-hoc guile-bootstrap
+
+# Ignoring unauthorized files.
+cat > "$tmpdir/guix.scm" <<EOF
+This is a broken guix.scm file.
+EOF
+! (cd "$tmpdir"; SHELL="$(type -P true)" guix shell --bootstrap 2> "stderr")
+grep "not authorized" "$tmpdir/stderr"
+rm "$tmpdir/stderr"
+
+# Authorize the directory.
+echo "$(realpath "$tmpdir")" > "$configdir/guix/shell-authorized-directories"
+
+# Ignoring 'manifest.scm' and 'guix.scm' in non-interactive use.
+(cd "$tmpdir"; guix shell --bootstrap -- true)
+mv "$tmpdir/guix.scm" "$tmpdir/manifest.scm"
+(cd "$tmpdir"; guix shell --bootstrap -- true)
+rm "$tmpdir/manifest.scm"
+
+# Honoring the local 'manifest.scm' file.
+cat > "$tmpdir/manifest.scm" <<EOF
+(specifications->manifest '("guile-bootstrap"))
+EOF
+cat > "$tmpdir/fake-shell.sh" <<EOF
+#!$SHELL
+# This fake shell allows us to test interactive use.
+exec echo "\$GUIX_ENVIRONMENT"
+EOF
+chmod +x "$tmpdir/fake-shell.sh"
+profile1="$(cd "$tmpdir"; SHELL="$(realpath fake-shell.sh)" guix shell --bootstrap)"
+profile2="$(guix shell --bootstrap guile-bootstrap -- "$SHELL" -c 'echo $GUIX_ENVIRONMENT')"
+test -n "$profile1"
+test "$profile1" = "$profile2"
+rm "$tmpdir/manifest.scm"
+
+# Do not read manifest when passed '-q'.
+echo "Broken manifest." > "$tmpdir/manifest.scm"
+(cd "$tmpdir"; SHELL="$(realpath fake-shell.sh)" guix shell --bootstrap -q)
+rm "$tmpdir/manifest.scm"
+
+if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
+then
+    # Compute the build environment for the initial GNU Make.
+    guix shell --bootstrap --no-substitutes --search-paths --pure \
+         -D -e '(@ (guix tests) gnu-make-for-tests)' > "$tmpdir/a"
+
+    # Make sure bootstrap binaries are in the profile.
+    profile=`grep "^export PATH" "$tmpdir/a" | sed -r 's|^.*="(.*)/bin"|\1|'`
+
+    # Make sure the bootstrap binaries are all listed where they belong.
+    grep -E "^export PATH=\"$profile/bin\""         "$tmpdir/a"
+    grep -E "^export CPATH=\"$profile/include\""    "$tmpdir/a"
+    grep -E "^export LIBRARY_PATH=\"$profile/lib\"" "$tmpdir/a"
+    for dep in bootstrap-binaries-0 gcc-bootstrap-0 glibc-bootstrap-0
+    do
+	guix gc --references "$profile" | grep "$dep"
+    done
+
+    # 'make-boot0' itself must not be listed.
+    ! guix gc --references "$profile" | grep make-boot0
+
+    # Honoring the local 'guix.scm' file.
+    echo '(@ (guix tests) gnu-make-for-tests)' > "$tmpdir/guix.scm"
+    (cd "$tmpdir"; guix shell --bootstrap --search-paths --pure > "b")
+    cmp "$tmpdir/a" "$tmpdir/b"
+    rm "$tmpdir/guix.scm"
+fi
diff --git a/tests/home-import.scm b/tests/home-import.scm
new file mode 100644
index 0000000000..abd3cec43d
--- /dev/null
+++ b/tests/home-import.scm
@@ -0,0 +1,187 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;;
+;;; 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-home-import)
+  #:use-module (guix scripts home import)
+  #:use-module (guix utils)
+  #:use-module (guix build utils)
+  #:use-module (guix packages)
+  #:use-module (ice-9 match)
+  #:use-module ((guix profiles) #:hide (manifest->code))
+  #:use-module ((guix build syscalls) #:select (mkdtemp!))
+  #:use-module ((guix scripts package)
+                #:select (manifest-entry-version-prefix))
+  #:use-module (gnu packages)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-64))
+
+;; Test the (guix scripts home import) tools.
+
+(test-begin "home-import")
+
+;; Example manifest entries.
+
+(define guile-2.0.9
+  (manifest-entry
+    (name "guile")
+    (version "2.0.9")
+    (item "/gnu/store/...")))
+
+(define glibc
+  (manifest-entry
+    (name "glibc")
+    (version "2.19")
+    (item "/gnu/store/...")))
+
+(define gcc
+  (manifest-entry
+    (name "gcc")
+    (version "10.3.0")
+    (item "/gnu/store/...")))
+
+;; Helpers for checking and generating home environments.
+
+(define %destination-directory "/tmp/guix-config")
+(mkdir-p %destination-directory)
+
+(define %temporary-home-directory (mkdtemp! "/tmp/guix-home-import.XXXXXX"))
+
+(define-syntax-rule (define-home-environment-matcher name pattern)
+  (define (name obj)
+    (match obj
+      (pattern #t)
+      (x (pk 'fail x #f)))))
+
+(define (create-temporary-home files-alist)
+  "Create a temporary home directory in '%temporary-home-directory'.
+FILES-ALIST is an association list of files and the content of the
+corresponding file."
+  (define (create-file file content)
+    (let ((absolute-path (string-append %temporary-home-directory "/" file)))
+      (unless (file-exists? absolute-path)
+        (mkdir-p (dirname absolute-path)))
+      (call-with-output-file absolute-path
+        (cut display content <>))))
+
+  (for-each (match-lambda
+              ((file . content) (create-file file content)))
+            files-alist))
+
+(define (eval-test-with-home-environment files-alist manifest matcher)
+  (create-temporary-home files-alist)
+  (setenv "HOME" %temporary-home-directory)
+  (mkdir-p %temporary-home-directory)
+  (let* ((home-environment (manifest+configuration-files->code
+                            manifest %destination-directory))
+         (result (matcher home-environment)))
+    (delete-file-recursively %temporary-home-directory)
+    result))
+
+(define-home-environment-matcher match-home-environment-no-services
+  ('begin
+    ('use-modules
+     ('gnu 'home)
+     ('gnu 'packages)
+     ('gnu 'services))
+    ('home-environment
+     ('packages
+      ('map 'specification->package
+            ('list "guile@2.0.9" "gcc" "glibc@2.19")))
+     ('services
+      ('list)))))
+
+(define-home-environment-matcher match-home-environment-transformations
+  ('begin
+    ('use-modules
+     ('gnu 'home)
+     ('gnu 'packages)
+     ('gnu 'services)
+     ('guix 'transformations))
+
+    ('define transform ('options->transformation _))
+    ('home-environment
+     ('packages
+      ('list (transform ('specification->package "guile@2.0.9"))
+             ('specification->package "gcc")
+             ('specification->package "glibc@2.19")))
+     ('services ('list)))))
+
+(define-home-environment-matcher match-home-environment-no-services-nor-packages
+  ('begin
+    ('use-modules
+     ('gnu 'home)
+     ('gnu 'packages)
+     ('gnu 'services))
+    ('home-environment
+     ('packages
+      ('map 'specification->package
+            ('list)))
+     ('services
+      ('list)))))
+
+(define-home-environment-matcher match-home-environment-bash-service
+  ('begin
+    ('use-modules
+     ('gnu 'home)
+     ('gnu 'packages)
+     ('gnu 'services)
+     ('guix 'gexp)
+     ('gnu 'home 'services 'shells))
+    ('home-environment
+     ('packages
+      ('map 'specification->package
+            ('list)))
+     ('services
+      ('list ('service
+              'home-bash-service-type
+              ('home-bash-configuration
+               ('bashrc
+                ('list ('local-file "/tmp/guix-config/.bashrc"
+                                    "bashrc"))))))))))
+
+
+(test-assert "manifest->code: No services"
+  (eval-test-with-home-environment
+   '()
+   (make-manifest (list guile-2.0.9 gcc glibc))
+   match-home-environment-no-services))
+
+(test-assert "manifest->code: No services, package transformations"
+  (eval-test-with-home-environment
+   '()
+   (make-manifest (list (manifest-entry
+                          (inherit guile-2.0.9)
+                          (properties `((transformations
+                                         . ((foo . "bar"))))))
+                        gcc glibc))
+   match-home-environment-transformations))
+
+(test-assert "manifest->code: No packages nor services"
+  (eval-test-with-home-environment
+   '()
+   (make-manifest '())
+   match-home-environment-no-services-nor-packages))
+
+(test-assert "manifest->code: Bash service"
+  (eval-test-with-home-environment
+   '((".bashrc" . "echo 'hello guix'"))
+   (make-manifest '())
+   match-home-environment-bash-service))
+
+(test-end "home-import")
diff --git a/tests/lint.scm b/tests/lint.scm
index ddef50b98b..a2e9699d5a 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -177,6 +177,20 @@
                               (description "Whitespace. "))))
      (check-description-style pkg))))
 
+(test-equal "description: pluralized 'This package'"
+  "description contains typo 'This packages', should be 'This package'"
+  (single-lint-warning-message
+   (let ((pkg (dummy-package "x"
+                             (description "This packages is a typo."))))
+     (check-description-style pkg))))
+
+(test-equal "description: grammar 'allows to'"
+  "description contains typo 'allows to'"
+  (single-lint-warning-message
+   (let ((pkg (dummy-package "x"
+                             (description "This package allows to do stuff."))))
+     (check-description-style pkg))))
+
 (test-equal "synopsis: not a string"
   "invalid synopsis: #f"
   (single-lint-warning-message
diff --git a/tests/packages.scm b/tests/packages.scm
index a9494b5c0e..3506f94f91 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -358,6 +358,20 @@
           (package-transitive-supported-systems d)
           (package-transitive-supported-systems e))))
 
+(test-assert "package-development-inputs"
+  ;; Note: Due to propagated inputs, 'package-development-inputs' returns a
+  ;; couple more inputs, such as 'linux-libre-headers'.
+  (lset<= equal?
+          `(("source" ,(package-source hello)) ,@(standard-packages))
+          (package-development-inputs hello)))
+
+(test-assert "package-development-inputs, cross-compilation"
+  (lset<= equal?
+          `(("source" ,(package-source hello))
+            ,@(standard-cross-packages "mips64el-linux-gnu" 'host)
+            ,@(standard-cross-packages "mips64el-linux-gnu" 'target))
+          (package-development-inputs hello #:target "mips64el-linux-gnu")))
+
 (test-assert "package-closure"
   (let-syntax ((dummy-package/no-implicit
                 (syntax-rules ()
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 06a0387221..cac5b73347 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -265,6 +265,13 @@
            (manifest-transaction-removal-candidate? guile-2.0.9 t)
            (null? install) (null? downgrade) (null? upgrade)))))
 
+(test-assert "package->development-manifest"
+  (let ((manifest (package->development-manifest packages:hello)))
+    (every (lambda (name)
+             (manifest-installed? manifest
+                                  (manifest-pattern (name name))))
+           '("gcc" "binutils" "glibc" "coreutils" "grep" "sed"))))
+
 (test-assertm "profile-derivation"
   (mlet* %store-monad
       ((entry ->   (package->manifest-entry %bootstrap-guile))
diff --git a/tests/store.scm b/tests/store.scm
index d895a328a4..7fc2988476 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -490,6 +490,34 @@
             (equal? (map derivation-file-name (drop d 16)) batch3)
             lst)))))
 
+(test-equal "map/accumulate-builds and different store"
+  '(d2)                               ;see <https://issues.guix.gnu.org/46756>
+  (let* ((b  (add-text-to-store %store "build" "echo $foo > $out" '()))
+         (s  (add-to-store %store "bash" #t "sha256"
+                           (search-bootstrap-binary "bash"
+                                                    (%current-system))))
+         (d1 (derivation %store "first"
+                         s `("-e" ,b)
+                         #:env-vars `(("foo" . ,(random-text)))
+                         #:sources (list b s)))
+         (d2 (derivation %store "second"
+                         s `("-e" ,b)
+                         #:env-vars `(("foo" . ,(random-text))
+                                      ("bar" . "baz"))
+                         #:sources (list b s))))
+    (with-store alternate-store
+      (with-build-handler (lambda (continue store things mode)
+                            ;; If this handler is called, it means that
+                            ;; 'map/accumulate-builds' triggered a build,
+                            ;; which it shouldn't since the inner
+                            ;; 'build-derivations' call is for another store.
+                            'failed)
+        (map/accumulate-builds %store
+                               (lambda (drv)
+                                 (build-derivations alternate-store (list d2))
+                                 'd2)
+                               (list d1))))))
+
 (test-assert "mapm/accumulate-builds"
   (let* ((d1 (run-with-store %store
                (gexp->derivation "foo" #~(mkdir #$output))))
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 706dd4177f..c9e011f453 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -26,6 +26,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64)
+  #:use-module (srfi srfi-71)
   #:use-module (system foreign)
   #:use-module ((ice-9 ftw) #:select (scandir))
   #:use-module (ice-9 match))
@@ -582,6 +583,40 @@
 (test-assert "terminal-rows"
   (> (terminal-rows) 0))
 
+(test-assert "openpty"
+  (let ((head inferior (openpty)))
+    (and (integer? head) (integer? inferior)
+         (let ((port (fdopen inferior "r+0")))
+           (and (isatty? port)
+                (begin
+                  (close-port port)
+                  (close-fdes head)
+                  #t))))))
+
+(test-equal "openpty + login-tty"
+  '(hello world)
+  (let ((head inferior (openpty)))
+    (match (primitive-fork)
+      (0
+       (dynamic-wind
+         (const #t)
+         (lambda ()
+           (setvbuf (current-input-port) 'none)
+           (close-fdes head)
+           (login-tty inferior)
+           (write (read))
+           (read))                          ;this gets EIO when HEAD is closed
+         (lambda ()
+           (primitive-_exit 42))))
+      (pid
+       (close-fdes inferior)
+       (let ((head (fdopen head "r+0")))
+         (write '(hello world) head)
+         (let ((result (read head)))
+           (close-port head)
+           (waitpid pid)
+           result))))))
+
 (test-assert "utmpx-entries"
   (match (utmpx-entries)
     (((? utmpx? entries) ...)