GNU bug report logs - #50873
[PATCH 0/5] Fixes to ‘guix home import’

Previous Next

Full log

View this message in rfc822 format

From: Xinglu Chen <public <at> yoctocell.xyz>
To: 50873 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>, Ludovic Courtès <ludo <at> gnu.org>, Andrew Tropin <andrew <at> trop.in>
Subject: [bug#50873] [PATCH 7/7] Add tests for ‘guix home import’.
Date: Sun, 10 Oct 2021 12:20:49 +0200

* tests/home-import.scm: New file.
* Makefile.am (SCM_TESTS): Add it.
---
 Makefile.am                  |   1 +
 guix/scripts/home/import.scm |   5 +-
 tests/home-import.scm        | 174 +++++++++++++++++++++++++++++++++++
 3 files changed, 179 insertions(+), 1 deletion(-)
 create mode 100644 tests/home-import.scm

diff --git a/Makefile.am b/Makefile.am
index 635147efc1..f93199e561 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -474,6 +474,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 b892ae3dfa..c68cfb9e78 100644
--- a/guix/scripts/home/import.scm
+++ b/guix/scripts/home/import.scm
@@ -28,7 +28,10 @@ (define-module (guix scripts home import)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:export (import-manifest
-            %destination-directory))
+            %destination-directory
+
+            ;; For tests.
+            manifest->code))
 
 ;;; Commentary:
 ;;;
diff --git a/tests/home-import.scm b/tests/home-import.scm
new file mode 100644
index 0000000000..8d141bba0f
--- /dev/null
+++ b/tests/home-import.scm
@@ -0,0 +1,174 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public <at> 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 (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.
+
+(%destination-directory "/tmp/guix-config")
+(mkdir-p (%destination-directory))
+
+(define %temporary-home-directory "/tmp/guix-home-import-test")
+
+(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 (pk (dirname absolute-path))))
+      (call-with-output-file (pk absolute-path)
+        (cut display content <>))))
+
+  (for-each (match-lambda
+              ((file . content) (create-file file content)))
+            (pk 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
+                                           #: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))
+    ('home-environment
+     ('packages
+      ('map 'specification->package
+            ('list "guile <at> 2.0.9" "gcc" "glibc <at> 2.19")))
+     ('services
+      ('list)))))
+
+(define-home-environment-matcher match-home-environment-no-services-nor-packages
+  ('begin
+    ('use-modules
+     ('gnu 'home)
+     ('gnu 'packages))
+    ('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 '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

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.