From 40acbaf0789d47464062622bef463921556c2235 Mon Sep 17 00:00:00 2001 From: Xinglu Chen Date: Sat, 30 Oct 2021 12:42:41 +0200 Subject: Add tests for ‘guix home import’. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * tests/home-import.scm: New file. * Makefile.am (SCM_TESTS): Add it. Signed-off-by: Ludovic Courtès --- tests/home-import.scm | 179 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 179 insertions(+) create mode 100644 tests/home-import.scm (limited to 'tests/home-import.scm') diff --git a/tests/home-import.scm b/tests/home-import.scm new file mode 100644 index 0000000000..691e8196d6 --- /dev/null +++ b/tests/home-import.scm @@ -0,0 +1,179 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Xinglu Chen +;;; +;;; 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 . + +(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") -- cgit v1.2.3 From ea19381bd9405bdb711c36b534e463fc7c8ca949 Mon Sep 17 00:00:00 2001 From: Xinglu Chen Date: Sat, 30 Oct 2021 12:42:44 +0200 Subject: guix home: import: Call ‘local-file’ with ‘name’ MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Set the name of the file to just the basename of the file passed to ‘local-file’. * guix/scripts/home/import.scm (basename+remove-dots): New procedure. (generate-bash-configuration+modules): Use it. * tests/home-import.scm (match-home-environment-bash-service): Adjust accordingly. Signed-off-by: Ludovic Courtès --- guix/scripts/home/import.scm | 20 ++++++++++++++++---- tests/home-import.scm | 3 ++- 2 files changed, 18 insertions(+), 5 deletions(-) (limited to 'tests/home-import.scm') diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm index 6e3ed065d5..a0022458f6 100644 --- a/guix/scripts/home/import.scm +++ b/guix/scripts/home/import.scm @@ -39,7 +39,16 @@ (define-module (guix scripts home import) ;;; ;;; Code: - +(define (basename+remove-dots file-name) + "Remove the dot from the dotfile FILE-NAME; replace the other dots in +FILE-NAME with \"-\", and return the basename of it." + (string-map (match-lambda + (#\. #\-) + (c c)) + (let ((base (basename file-name))) + (if (string-prefix? "." base) + (string-drop base 1) + base)))) (define (generate-bash-configuration+modules destination-directory) (define (destination-append path) @@ -52,15 +61,18 @@ (define (destination-append path) (home-bash-configuration ,@(if (file-exists? rc) `((bashrc - (list (local-file ,rc)))) + (list (local-file ,rc + ,(basename+remove-dots rc))))) '()) ,@(if (file-exists? profile) `((bash-profile - (list (local-file ,profile)))) + (list (local-file ,profile + ,(basename+remove-dots profile))))) '()) ,@(if (file-exists? logout) `((bash-logout - (list (local-file ,logout)))) + (list (local-file ,logout + ,(basename+remove-dots logout))))) '()))) (guix gexp) (gnu home services shells)))) diff --git a/tests/home-import.scm b/tests/home-import.scm index 691e8196d6..40d9547e8b 100644 --- a/tests/home-import.scm +++ b/tests/home-import.scm @@ -156,7 +156,8 @@ (define-home-environment-matcher match-home-environment-bash-service 'home-bash-service-type ('home-bash-configuration ('bashrc - ('list ('local-file "/tmp/guix-config/.bashrc")))))))))) + ('list ('local-file "/tmp/guix-config/.bashrc" + "bashrc")))))))))) (test-assert "manifest->code: No services" (eval-test-with-home-environment -- cgit v1.2.3 From 96728c54df365cc48f14a514b63616ff7a6d052b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 30 Oct 2021 23:30:50 +0200 Subject: home: import: Factorize triplicated 'version-spec' procedure. * guix/scripts/package.scm (manifest-entry-version-prefix): New procedure, moved from... (export-manifest)[version-spec]: ... here. Adjust caller. * tests/home-import.scm (version-spec): Remove. (eval-test-with-home-environment): Use 'manifest-entry-version-prefix' instead. * guix/scripts/home/import.scm (import-manifest): Likewise. --- guix/scripts/home/import.scm | 23 ++-------------------- guix/scripts/package.scm | 47 ++++++++++++++++++++++++-------------------- tests/home-import.scm | 26 ++++-------------------- 3 files changed, 32 insertions(+), 64 deletions(-) (limited to 'tests/home-import.scm') diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm index a51f7f504b..8f6b3b58aa 100644 --- a/guix/scripts/home/import.scm +++ b/guix/scripts/home/import.scm @@ -22,6 +22,7 @@ (define-module (guix scripts home import) #:use-module (guix ui) #:use-module (guix utils) #:use-module (guix packages) + #:autoload (guix scripts package) (manifest-entry-version-prefix) #:use-module (gnu packages) #:use-module (ice-9 match) #:use-module (ice-9 pretty-print) @@ -241,28 +242,8 @@ (define* (import-manifest manifest destination-directory #:optional (port (current-output-port))) "Write to PORT a corresponding to MANIFEST." - (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))))))) - (match (manifest->code manifest destination-directory - #:entry-package-version version-spec + #:entry-package-version manifest-entry-version-prefix #:home-environment? #t) (('begin exp ...) (format port (G_ "\ diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index a34ecdcb54..4b9c5f210d 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -68,6 +68,7 @@ (define-module (guix scripts package) guix-package search-path-environment-variables + manifest-entry-version-prefix transaction-upgrade-entry ;mostly for testing @@ -327,31 +328,35 @@ (define (display-search-path-hint entries profile) ;;; Export a manifest. ;;; +(define (manifest-entry-version-prefix entry) + "Search among all the versions of ENTRY's package that are available, and +return the shortest unambiguous version prefix for this package. If only one +version of ENTRY's package is available, return the empty string." + (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* (export-manifest manifest #:optional (port (current-output-port))) "Write to PORT a manifest corresponding to MANIFEST." - (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))))))) - (match (manifest->code manifest - #:entry-package-version version-spec) + #:entry-package-version + manifest-entry-version-prefix) (('begin exp ...) (format port (G_ "\ ;; This \"manifest\" file can be passed to 'guix package -m' to reproduce diff --git a/tests/home-import.scm b/tests/home-import.scm index 40d9547e8b..dc413d8516 100644 --- a/tests/home-import.scm +++ b/tests/home-import.scm @@ -24,6 +24,8 @@ (define-module (test-home-import) #: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) @@ -81,33 +83,13 @@ (define (create-file file content) ((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 + #:entry-package-version + manifest-entry-version-prefix #:home-environment? #t)) (result (matcher home-environment))) (delete-file-recursively %temporary-home-directory) -- cgit v1.2.3 From 6f4ca78761471602e3af37ee1a33de446114039f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 31 Oct 2021 00:02:27 +0200 Subject: home: import: Avoid duplication of 'manifest->code'. * guix/scripts/home/import.scm (manifest->code): Remove. (manifest+configuration-files->code): New procedure. (import-manifest): Use 'manifest+configuration-files->code' instead of 'manifest->code'. * tests/home-import.scm (eval-test-with-home-environment): Likewise. (match-home-environment-transformations): New procedure. ("manifest->code: No services, package transformations"): New test. --- guix/scripts/home/import.scm | 176 ++++++++++--------------------------------- tests/home-import.scm | 33 +++++++- 2 files changed, 69 insertions(+), 140 deletions(-) (limited to 'tests/home-import.scm') diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm index 8f6b3b58aa..7a7712dd96 100644 --- a/guix/scripts/home/import.scm +++ b/guix/scripts/home/import.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Xinglu Chen ;;; Copyright © 2021 Andrew Tropin +;;; Copyright © 2021 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,7 +32,7 @@ (define-module (guix scripts home import) #:export (import-manifest ;; For tests. - manifest->code)) + manifest+configuration-files->code)) ;;; Commentary: ;;; @@ -105,146 +106,49 @@ (define configurations (map (lambda (proc) (proc configuration-directory)) configurations)) -;; Based on `manifest->code' from (guix profiles) -;; MAYBE: Upstream it? -(define* (manifest->code manifest destination-directory - #:key - (entry-package-version (const "")) - (home-environment? #f)) - "Return an sexp representing code to build an approximate version of -MANIFEST; the code is wrapped in a top-level 'begin' form. If -HOME-ENVIRONMENT? is #t, return an definition. -Call ENTRY-PACKAGE-VERSION to determine the version number to use in -the spec for a given entry; it can be set to 'manifest-entry-version' -for fully-specified version numbers, or to some other procedure to -disambiguate versions for packages for which several versions are -available." - (define (entry-transformations entry) - ;; Return the transformations that apply to ENTRY. - (assoc-ref (manifest-entry-properties entry) 'transformations)) - - (define transformation-procedures - ;; List of transformation options/procedure name pairs. - (let loop ((entries (manifest-entries manifest)) - (counter 1) - (result '())) - (match entries - (() result) - ((entry . tail) - (match (entry-transformations entry) - (#f - (loop tail counter result)) - (options - (if (assoc-ref result options) - (loop tail counter result) - (loop tail (+ 1 counter) - (alist-cons options - (string->symbol - (format #f "transform~a" counter)) - result))))))))) - - (define (qualified-name entry) - ;; Return the name of ENTRY possibly with "@" followed by a version. - (match (entry-package-version entry) - ("" (manifest-entry-name entry)) - (version (string-append (manifest-entry-name entry) - "@" version)))) - - (if (null? transformation-procedures) - (let ((specs (map (lambda (entry) - (match (manifest-entry-output entry) - ("out" (qualified-name entry)) - (output (string-append (qualified-name entry) - ":" output)))) - (manifest-entries manifest)))) - (if home-environment? - (let ((configurations+modules - (configurations+modules destination-directory))) - `(begin - (use-modules (gnu home) - (gnu packages) - (gnu services) - ,@((compose delete-duplicates concatenate) - (map cdr configurations+modules))) - ,(home-environment-template - #:specs specs - #:services (map first configurations+modules)))) - `(begin - (use-modules (gnu packages)) - - (specifications->manifest - (list ,@specs))))) - (let* ((transform (lambda (options exp) - (if (not options) - exp - (let ((proc (assoc-ref transformation-procedures - options))) - `(,proc ,exp))))) - (packages (map (lambda (entry) - (define options - (entry-transformations entry)) - - (define name - (qualified-name entry)) - - (match (manifest-entry-output entry) - ("out" - (transform options - `(specification->package ,name))) - (output - `(list ,(transform - options - `(specification->package ,name)) - ,output)))) - (manifest-entries manifest))) - (transformations (map (match-lambda - ((options . name) - `(define ,name - (options->transformation ',options)))) - transformation-procedures))) - (if home-environment? - (let ((configurations+modules - (configurations+modules destination-directory))) - `(begin - (use-modules (guix transformations) - (gnu home) - (gnu packages) - (gnu services) - ,@((compose delete-duplicates concatenate) - (map cdr configurations+modules))) - - ,@transformations - - ,(home-environment-template - #:packages packages - #:services (map first configurations+modules)))) - `(begin - (use-modules (guix transformations) - (gnu packages)) - - ,@transformations - - (packages->manifest - (list ,@packages))))))) - -(define* (home-environment-template #:key (packages #f) (specs #f) services) - "Return an S-exp containing a declaration -containing PACKAGES, or SPECS (package specifications), and SERVICES." - `(home-environment - (packages - ,@(if packages - `((list ,@packages)) - `((map specification->package - (list ,@specs))))) - (services (list ,@services)))) +(define (manifest+configuration-files->code manifest + configuration-directory) + "Read MANIFEST and the user's configuration files listed in +%FILES+CONFIGURATIONS-ALIST, and return a 'home-environment' sexp. Copy the +user's files to CONFIGURATION-DIRECTORY; the generated sexp refers to them." + (match (manifest->code manifest + #:entry-package-version + manifest-entry-version-prefix) + (('begin ('use-modules profile-modules ...) + definitions ... ('packages->manifest packages)) + (match (configurations+modules configuration-directory) + (((services . modules) ...) + `(begin + (use-modules (gnu home) + (gnu packages) + (gnu services) + ,@(delete-duplicates + (append profile-modules (concatenate modules)))) + + ,@definitions + + (home-environment + (packages ,packages) + (services (list ,@services))))))) + (('begin ('specifications->manifest packages)) + (match (configurations+modules configuration-directory) + (((services . modules) ...) + `(begin + (use-modules (gnu home) + (gnu packages) + (gnu services) + ,@(delete-duplicates (concatenate modules))) + + (home-environment + (packages (map specification->package ,packages)) + (services (list ,@services))))))))) (define* (import-manifest manifest destination-directory #:optional (port (current-output-port))) "Write to PORT a corresponding to MANIFEST." - (match (manifest->code manifest destination-directory - #:entry-package-version manifest-entry-version-prefix - #:home-environment? #t) + (match (manifest+configuration-files->code manifest + destination-directory) (('begin exp ...) (format port (G_ "\ ;; This \"home-environment\" file can be passed to 'guix home reconfigure' diff --git a/tests/home-import.scm b/tests/home-import.scm index dc413d8516..abd3cec43d 100644 --- a/tests/home-import.scm +++ b/tests/home-import.scm @@ -87,10 +87,8 @@ (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 - manifest-entry-version-prefix - #:home-environment? #t)) + (let* ((home-environment (manifest+configuration-files->code + manifest %destination-directory)) (result (matcher home-environment))) (delete-file-recursively %temporary-home-directory) result)) @@ -108,6 +106,22 @@ (define-home-environment-matcher match-home-environment-no-services ('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 @@ -141,12 +155,23 @@ (define-home-environment-matcher match-home-environment-bash-service ('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 '() -- cgit v1.2.3