Toggle diff (224 lines)
diff --git a/Makefile.am b/Makefile.am
index 239387c2f4..d608b08899 100644
--- a/Makefile.am
+++ b/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 \
diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm
index f0ae233b75..6e3ed065d5 100644
--- a/guix/scripts/home/import.scm
+++ b/guix/scripts/home/import.scm
@@ -27,7 +27,10 @@ (define-module (guix scripts home import)
#: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 @@ (define-module (guix scripts home import)
;;;
;;; Code:
+
+
(define (generate-bash-configuration+modules destination-directory)
(define (destination-append path)
(string-append destination-directory "/" path))
diff --git a/tests/home-import.scm b/tests/home-import.scm
new file mode 100644
index 0000000000..a4e71fa698
--- /dev/null
+++ b/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")
--
2.33.0