diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/guix-package.sh | 15 | ||||
| -rw-r--r-- | tests/inferior.scm | 123 |
2 files changed, 137 insertions, 1 deletions
diff --git a/tests/guix-package.sh b/tests/guix-package.sh index cef3b3452e..f7dfbfad00 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -358,6 +358,21 @@ EOF guix package --bootstrap -m "$module_dir/manifest.scm" guix package -I | grep guile test `guix package -I | wc -l` -eq 1 +guix package --rollback --bootstrap + +# Applying a manifest file with inferior packages. +cat > "$module_dir/manifest.scm"<<EOF +(use-modules (guix inferior)) + +(define i + (open-inferior "$abs_top_srcdir" #:command "scripts/guix")) + +(let ((guile (car (lookup-inferior-packages i "guile-bootstrap")))) + (packages->manifest (list guile))) +EOF +guix package --bootstrap -m "$module_dir/manifest.scm" +guix package -I | grep guile +test `guix package -I | wc -l` -eq 1 # Error reporting. cat > "$module_dir/manifest.scm"<<EOF diff --git a/tests/inferior.scm b/tests/inferior.scm index ff5cad4210..d1d5c00a77 100644 --- a/tests/inferior.scm +++ b/tests/inferior.scm @@ -17,11 +17,18 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (test-inferior) + #:use-module (guix tests) #:use-module (guix inferior) #:use-module (guix packages) + #:use-module (guix store) + #:use-module (guix profiles) + #:use-module (guix derivations) #:use-module (gnu packages) + #:use-module (gnu packages bootstrap) + #:use-module (gnu packages guile) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-64)) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) (define %top-srcdir (dirname (search-path %load-path "guix.scm"))) @@ -29,6 +36,16 @@ (define %top-builddir (dirname (search-path %load-compiled-path "guix.go"))) +(define %store + (open-connection-for-tests)) + +(define (manifest-entry->list entry) + (list (manifest-entry-name entry) + (manifest-entry-version entry) + (manifest-entry-output entry) + (manifest-entry-search-paths entry) + (map manifest-entry->list (manifest-entry-dependencies entry)))) + (test-begin "inferior") @@ -72,4 +89,108 @@ (close-inferior inferior) result)))) +(test-equal "lookup-inferior-packages" + (let ((->list (lambda (package) + (list (package-name package) + (package-version package) + (package-location package))))) + (list (map ->list (find-packages-by-name "guile" #f)) + (map ->list (find-packages-by-name "guile" "2.2")))) + (let* ((inferior (open-inferior %top-builddir + #:command "scripts/guix")) + (->list (lambda (package) + (list (inferior-package-name package) + (inferior-package-version package) + (inferior-package-location package)))) + (lst1 (map ->list + (lookup-inferior-packages inferior "guile"))) + (lst2 (map ->list + (lookup-inferior-packages inferior + "guile" "2.2")))) + (close-inferior inferior) + (list lst1 lst2))) + +(test-assert "lookup-inferior-packages and eq?-ness" + (let* ((inferior (open-inferior %top-builddir + #:command "scripts/guix")) + (lst1 (lookup-inferior-packages inferior "guile")) + (lst2 (lookup-inferior-packages inferior "guile"))) + (close-inferior inferior) + (every eq? lst1 lst2))) + +(test-equal "inferior-package-inputs" + (let ((->list (match-lambda + ((label (? package? package) . rest) + `(,label + (package ,(package-name package) + ,(package-version package) + ,(package-location package)) + ,@rest))))) + (list (map ->list (package-inputs guile-2.2)) + (map ->list (package-native-inputs guile-2.2)) + (map ->list (package-propagated-inputs guile-2.2)))) + (let* ((inferior (open-inferior %top-builddir + #:command "scripts/guix")) + (guile (first (lookup-inferior-packages inferior "guile"))) + (->list (match-lambda + ((label (? inferior-package? package) . rest) + `(,label + (package ,(inferior-package-name package) + ,(inferior-package-version package) + ,(inferior-package-location package)) + ,@rest)))) + (result (list (map ->list (inferior-package-inputs guile)) + (map ->list + (inferior-package-native-inputs guile)) + (map ->list + (inferior-package-propagated-inputs + guile))))) + (close-inferior inferior) + result)) + +(test-equal "inferior-package-search-paths" + (package-native-search-paths guile-2.2) + (let* ((inferior (open-inferior %top-builddir + #:command "scripts/guix")) + (guile (first (lookup-inferior-packages inferior "guile"))) + (result (inferior-package-native-search-paths guile))) + (close-inferior inferior) + result)) + +(test-equal "inferior-package-derivation" + (map derivation-file-name + (list (package-derivation %store %bootstrap-guile "x86_64-linux") + (package-derivation %store %bootstrap-guile "armhf-linux"))) + (let* ((inferior (open-inferior %top-builddir + #:command "scripts/guix")) + (packages (inferior-packages inferior)) + (guile (find (lambda (package) + (string=? (package-name %bootstrap-guile) + (inferior-package-name package))) + packages))) + (map derivation-file-name + (list (inferior-package-derivation %store guile "x86_64-linux") + (inferior-package-derivation %store guile "armhf-linux"))))) + +(test-equal "inferior-package->manifest-entry" + (manifest-entry->list (package->manifest-entry + (first (find-best-packages-by-name "guile" #f)))) + (let* ((inferior (open-inferior %top-builddir + #:command "scripts/guix")) + (guile (first (lookup-inferior-packages inferior "guile"))) + (entry (inferior-package->manifest-entry guile))) + (close-inferior inferior) + (manifest-entry->list entry))) + +(test-equal "packages->manifest" + (map manifest-entry->list + (manifest-entries (packages->manifest + (find-best-packages-by-name "guile" #f)))) + (let* ((inferior (open-inferior %top-builddir + #:command "scripts/guix")) + (guile (first (lookup-inferior-packages inferior "guile"))) + (manifest (packages->manifest (list guile)))) + (close-inferior inferior) + (map manifest-entry->list (manifest-entries manifest)))) + (test-end "inferior") |