diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/guix-package.sh | 10 | ||||
| -rw-r--r-- | tests/guix-system.sh | 4 | ||||
| -rw-r--r-- | tests/packages.scm | 36 | ||||
| -rw-r--r-- | tests/profiles.scm | 30 | ||||
| -rw-r--r-- | tests/store-database.scm | 19 | ||||
| -rw-r--r-- | tests/utils.scm | 8 |
6 files changed, 91 insertions, 16 deletions
diff --git a/tests/guix-package.sh b/tests/guix-package.sh index 3e5fa71d20..7eaad6823f 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> # # This file is part of GNU Guix. @@ -395,6 +395,14 @@ EOF guix package --bootstrap -m "$module_dir/manifest.scm" guix package -I | grep guile test `guix package -I | wc -l` -eq 1 + +# Export a manifest, instantiate it, and make sure we get the same profile. +profile_directory="$(readlink -f "$default_profile")" +guix package --export-manifest > "$tmpfile" +guix package --rollback --bootstrap +guix package --bootstrap -m "$tmpfile" +test "$(readlink -f "$default_profile")" = "$profile_directory" + guix package --rollback --bootstrap # Applying two manifests. diff --git a/tests/guix-system.sh b/tests/guix-system.sh index f5ddd1dda3..24cc2591d5 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -266,6 +266,10 @@ drv1="`guix system image -t iso9660 "$tmpfile" -d`" drv2="`guix system image -t iso9660 "$tmpfile" -d`" test "$drv1" = "$drv2" +# Check whether the graph commands work as expected. +guix system extension-graph "$tmpfile" | grep 'label = "file-systems"' +guix system shepherd-graph "$tmpfile" | grep 'label = "guix-daemon"' + make_user_config "group-that-does-not-exist" "users" if guix system build "$tmpfile" -n 2> "$errorfile" then false diff --git a/tests/packages.scm b/tests/packages.scm index 18e8e16e74..2a290bc353 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -42,6 +42,7 @@ #:use-module (guix memoization) #:use-module (guix profiles) #:use-module (guix scripts package) + #:use-module (guix sets) #:use-module (gnu packages) #:use-module (gnu packages base) #:use-module (gnu packages guile) @@ -54,6 +55,7 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (srfi srfi-64) + #:use-module (srfi srfi-71) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (ice-9 vlist) @@ -1549,17 +1551,27 @@ result)) '())))))) - (define (find-duplicates l) - (match l - (() '()) - ((head . tail) - (if (member head tail) - (cons head (find-duplicates tail)) - (find-duplicates tail))))) - - (pk (find-duplicates from-cache)) - (and (equal? (delete-duplicates from-cache) from-cache) - (lset= equal? no-cache from-cache)))) + (define (list->set* lst) + ;; Return two values: LST represented as a set and the list of + ;; duplicates in LST. + (let loop ((lst lst) + (duplicates '()) + (seen (set))) + (match lst + (() + (values seen duplicates)) + ((head . tail) + (if (set-contains? seen head) + (loop tail (cons head duplicates) seen) + (loop tail duplicates (set-insert head seen))))))) + + ;; Compare FROM-CACHE and NO-CACHE but avoid 'lset=', which exhibits + ;; exponential behavior. + (let ((set1 duplicates1 (list->set* from-cache)) + (set2 duplicates2 (list->set* no-cache))) + (and (null? duplicates1) (null? duplicates2) + (every (cut set-contains? set1 <>) no-cache) + (every (cut set-contains? set2 <>) from-cache))))) (test-assert "find-packages-by-name" (match (find-packages-by-name "hello") diff --git a/tests/profiles.scm b/tests/profiles.scm index 2dec42bec1..ce77711d63 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Alex Kost <alezost@gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -154,6 +154,34 @@ (manifest-entries (manifest-add (manifest '()) (list guile-2.0.9 guile-2.0.9)))) +(test-equal "manifest->code, simple" + '(begin + (specifications->manifest (list "guile" "guile:debug" "glibc"))) + (manifest->code (manifest (list guile-2.0.9 guile-2.0.9:debug glibc)))) + +(test-equal "manifest->code, simple, versions" + '(begin + (specifications->manifest (list "guile@2.0.9" "guile@2.0.9:debug" + "glibc@2.19"))) + (manifest->code (manifest (list guile-2.0.9 guile-2.0.9:debug glibc)) + #:entry-package-version manifest-entry-version)) + +(test-equal "manifest->code, transformations" + '(begin + (use-modules (guix transformations)) + + (define transform1 + (options->transformation '((foo . "bar")))) + + (packages->manifest + (list (transform1 (specification->package "guile")) + (specification->package "glibc")))) + (manifest->code (manifest (list (manifest-entry + (inherit guile-2.0.9) + (properties `((transformations + . ((foo . "bar")))))) + glibc)))) + (test-assert "manifest-perform-transaction" (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug))) (t1 (manifest-transaction diff --git a/tests/store-database.scm b/tests/store-database.scm index 17eea38c63..d8f3ce8070 100644 --- a/tests/store-database.scm +++ b/tests/store-database.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -123,4 +123,21 @@ (pk 'welcome-exception! args) #t))))) +(test-equal "sqlite-register with incorrect size" + 'out-of-range + (call-with-temporary-output-file + (lambda (db-file port) + (delete-file db-file) + (catch #t + (lambda () + (with-database db-file db + (sqlite-register db #:path "/gnu/foo" + #:references '("/gnu/bar") + #:deriver "/gnu/foo.drv" + #:hash (string-append "sha256:" (make-string 64 #\e)) + #:nar-size -1234)) + #f) + (lambda (key . _) + key))))) + (test-end "store-database") diff --git a/tests/utils.scm b/tests/utils.scm index 9bce446d98..62ec7e8b4c 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> ;;; @@ -78,6 +78,12 @@ (not (version-prefix? "4.1" "4.16.2")) (not (version-prefix? "4.1" "4")))) +(test-equal "version-unique-prefix" + '("2" "2.2" "") + (list (version-unique-prefix "2.0" '("3.0" "2.0")) + (version-unique-prefix "2.2" '("3.0.5" "2.0.9" "2.2.7")) + (version-unique-prefix "27.1" '("27.1")))) + (test-equal "string-tokenize*" '(("foo") ("foo" "bar" "baz") |