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>master
Xinglu Chen
Ludovic Courtès
parent
87c04b0e17
commit
40acbaf078
|
|
@ -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 \
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
Reference in New Issue