Add tests for ‘guix home import’.

* tests/home-import.scm: New file.
* Makefile.am (SCM_TESTS): Add it.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>

Makefile.am

@@ -475,6 +475,7 @@ SCM_TESTS =					\
   tests/graph.scm				\
   tests/gremlin.scm				\
   tests/hackage.scm				\
+  tests/home-import.scm				\
   tests/import-git.scm				\
   tests/import-utils.scm			\
   tests/inferior.scm				\

guix/scripts/home/import.scm

@@ -27,7 +27,10 @@
   #:use-module (ice-9 pretty-print)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
-  #:export (import-manifest))
+  #:export (import-manifest
+
+            ;; For tests.
+            manifest->code))
 
 ;;; Commentary:
 ;;;
@@ -36,6 +39,8 @@
 ;;;
 ;;; Code:
 
+
+
 (define (generate-bash-configuration+modules destination-directory)
   (define (destination-append path)
     (string-append destination-directory "/" path))

tests/home-import.scm

@@ -0,0 +1,179 @@
+;;; 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 (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))
+
+;; Copied from (guix profiles)
+(define (version-spec entry)
+  (let ((name (manifest-entry-name entry)))
+    (match (map package-version (find-packages-by-name name))
+      ((_)
+       ;; A single version of NAME is available, so do not specify the
+       ;; version number, even if the available version doesn't match ENTRY.
+       "")
+      (versions
+       ;; If ENTRY uses the latest version, don't specify any version.
+       ;; Otherwise return the shortest unique version prefix.  Note that
+       ;; this is based on the currently available packages, which could
+       ;; differ from the packages available in the revision that was used
+       ;; to build MANIFEST.
+       (let ((current (manifest-entry-version entry)))
+         (if (every (cut version>? current <>)
+                    (delete current versions))
+             ""
+             (version-unique-prefix (manifest-entry-version entry)
+                                    versions)))))))
+
+(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->code manifest %destination-directory
+                                           #:entry-package-version version-spec
+                                           #:home-environment? #t))
+         (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-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"))))))))))
+
+(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 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")