diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/channels.scm | 88 | ||||
| -rw-r--r-- | tests/guix-package-net.sh | 33 | ||||
| -rw-r--r-- | tests/lint.scm | 2 | ||||
| -rw-r--r-- | tests/nar.scm | 36 | ||||
| -rw-r--r-- | tests/packages.scm | 77 | ||||
| -rw-r--r-- | tests/profiles.scm | 34 |
6 files changed, 256 insertions, 14 deletions
diff --git a/tests/channels.scm b/tests/channels.scm index f3fc383ac3..8540aef435 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -18,9 +18,16 @@ (define-module (test-channels) #:use-module (guix channels) + #:use-module (guix profiles) #:use-module ((guix build syscalls) #:select (mkdtemp!)) #:use-module (guix tests) + #:use-module (guix store) + #:use-module ((guix grafts) #:select (%graft?)) + #:use-module (guix derivations) + #:use-module (guix sets) + #:use-module (guix gexp) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) #:use-module (ice-9 match)) @@ -34,8 +41,9 @@ (and spec (with-output-to-file (string-append instance-dir "/.guix-channel") (lambda _ (format #t "~a" spec)))) - ((@@ (guix channels) channel-instance) - name commit instance-dir)) + (checkout->channel-instance instance-dir + #:commit commit + #:name name)) (define instance--boring (make-instance)) (define instance--no-deps @@ -136,4 +144,80 @@ 'abc1234))) instances)))))) +(test-assert "channel-instances->manifest" + ;; Compute the manifest for a graph of instances and make sure we get a + ;; derivation graph that mirrors the instance graph. This test also ensures + ;; we don't try to access Git repositores at all at this stage. + (let* ((spec (lambda deps + `(channel (version 0) + (dependencies + ,@(map (lambda (dep) + `(channel + (name ,dep) + (url "http://example.org"))) + deps))))) + (guix (make-instance #:name 'guix)) + (instance0 (make-instance #:name 'a)) + (instance1 (make-instance #:name 'b #:spec (spec 'a))) + (instance2 (make-instance #:name 'c #:spec (spec 'b))) + (instance3 (make-instance #:name 'd #:spec (spec 'c 'a)))) + (%graft? #f) ;don't try to build stuff + + ;; Create 'build-self.scm' so that GUIX is recognized as the 'guix' channel. + (let ((source (channel-instance-checkout guix))) + (mkdir (string-append source "/build-aux")) + (call-with-output-file (string-append source + "/build-aux/build-self.scm") + (lambda (port) + (write '(begin + (use-modules (guix) (gnu packages bootstrap)) + + (lambda _ + (package->derivation %bootstrap-guile))) + port)))) + + (with-store store + (let () + (define manifest + (run-with-store store + (channel-instances->manifest (list guix + instance0 instance1 + instance2 instance3)))) + + (define entries + (manifest-entries manifest)) + + (define (depends? drv in out) + ;; Return true if DRV depends (directly or indirectly) on all of IN + ;; and none of OUT. + (let ((set (list->set + (requisites store + (list (derivation-file-name drv))))) + (in (map derivation-file-name in)) + (out (map derivation-file-name out))) + (and (every (cut set-contains? set <>) in) + (not (any (cut set-contains? set <>) out))))) + + (define (lookup name) + (run-with-store store + (lower-object + (manifest-entry-item + (manifest-lookup manifest + (manifest-pattern (name name))))))) + + (let ((drv-guix (lookup "guix")) + (drv0 (lookup "a")) + (drv1 (lookup "b")) + (drv2 (lookup "c")) + (drv3 (lookup "d"))) + (and (depends? drv-guix '() (list drv0 drv1 drv2 drv3)) + (depends? drv0 + (list) (list drv1 drv2 drv3)) + (depends? drv1 + (list drv0) (list drv2 drv3)) + (depends? drv2 + (list drv1) (list drv3)) + (depends? drv3 + (list drv2 drv0) (list)))))))) + (test-end "channels") diff --git a/tests/guix-package-net.sh b/tests/guix-package-net.sh index 927c856b23..82c346dd4c 100644 --- a/tests/guix-package-net.sh +++ b/tests/guix-package-net.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org> +# Copyright © 2012, 2013, 2014, 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org> # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> # # This file is part of GNU Guix. @@ -167,6 +167,37 @@ then false; fi guix package -p "$profile" -p "$profile_alt" --search-paths \ | grep "LIBRARY_PATH.*$profile/lib.$profile_alt/lib" +# Simulate an upgrade and make sure the package order is preserved. +module_dir="t-guix-package-net-$$" +trap 'rm -rf "$module_dir"' EXIT + +mkdir "$module_dir" +cat > "$module_dir/new.scm" <<EOF +(define-module (new) + #:use-module (guix) + #:use-module (gnu packages bootstrap)) + +(define-public new-guile + (package (inherit %bootstrap-guile) + (version (string-append "42." (getenv "V_MINOR"))))) +(define-public new-gcc + (package (inherit %bootstrap-gcc) + (version (string-append "77." (getenv "V_MINOR"))))) +EOF + +guix package --bootstrap -p "$profile" -i gcc-bootstrap +installed="`guix package -p "$profile" -I | cut -f1`" + +for i in 1 2 +do + V_MINOR="$i" + export V_MINOR + + guix package -p "$profile" --bootstrap -L "$module_dir" -u . + post_upgrade="`guix package -p "$profile" -I | cut -f1`" + test "$post_upgrade" = "$installed" +done + # # Try with the default profile. # diff --git a/tests/lint.scm b/tests/lint.scm index 912a78d111..dc2b17aeec 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -38,7 +38,7 @@ #:use-module (gnu packages) #:use-module (gnu packages glib) #:use-module (gnu packages pkg-config) - #:use-module (gnu packages python) + #:use-module (gnu packages python-xyz) #:use-module (web uri) #:use-module (web server) #:use-module (web server http) diff --git a/tests/nar.scm b/tests/nar.scm index 5ffe68c9e2..bfc71c69a8 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -334,6 +334,40 @@ (lambda () (rmdir input))))) +(test-eq "restore-file with non-UTF8 locale" ;<https://bugs.gnu.org/33603> + 'encoding-error + (let* ((file (search-path %load-path "guix.scm")) + (output (string-append %test-dir "/output")) + (locale (setlocale LC_ALL "C"))) + (dynamic-wind + (lambda () #t) + (lambda () + (define-values (port get-bytevector) + (open-bytevector-output-port)) + + (write-file-tree "root" port + #:file-type+size + (match-lambda + ("root" (values 'directory 0)) + ("root/λ" (values 'regular 0))) + #:file-port (const (%make-void-port "r")) + #:symlink-target (const #f) + #:directory-entries (const '("λ"))) + (close-port port) + + (mkdir %test-dir) + (catch 'encoding-error + (lambda () + ;; This show throw to 'encoding-error. + (restore-file (open-bytevector-input-port (get-bytevector)) + output) + (scandir output)) + (lambda args + 'encoding-error))) + (lambda () + (false-if-exception (rm-rf %test-dir)) + (setlocale LC_ALL locale))))) + (test-assert "restore-file-set (signed, valid)" (with-store store (let* ((texts (unfold (cut >= <> 10) diff --git a/tests/packages.scm b/tests/packages.scm index 237feb7aba..ed635d9011 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 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -96,8 +96,8 @@ (test-assert "transaction-upgrade-entry, zero upgrades" (let* ((old (dummy-package "foo" (version "1"))) - (tx (mock ((gnu packages) find-newest-available-packages - (const vlist-null)) + (tx (mock ((gnu packages) find-best-packages-by-name + (const '())) ((@@ (guix scripts package) transaction-upgrade-entry) (manifest-entry (inherit (package->manifest-entry old)) @@ -109,8 +109,8 @@ (test-assert "transaction-upgrade-entry, one upgrade" (let* ((old (dummy-package "foo" (version "1"))) (new (dummy-package "foo" (version "2"))) - (tx (mock ((gnu packages) find-newest-available-packages - (const (vhash-cons "foo" (list "2" new) vlist-null))) + (tx (mock ((gnu packages) find-best-packages-by-name + (const (list new))) ((@@ (guix scripts package) transaction-upgrade-entry) (manifest-entry (inherit (package->manifest-entry old)) @@ -126,8 +126,8 @@ (let* ((old (dummy-package "foo" (version "1"))) (new (dummy-package "bar" (version "2"))) (dep (deprecated-package "foo" new)) - (tx (mock ((gnu packages) find-newest-available-packages - (const (vhash-cons "foo" (list "2" dep) vlist-null))) + (tx (mock ((gnu packages) find-best-packages-by-name + (const (list dep))) ((@@ (guix scripts package) transaction-upgrade-entry) (manifest-entry (inherit (package->manifest-entry old)) @@ -995,6 +995,28 @@ ((one) (eq? one guile-2.0)))) +(test-assert "fold-available-packages with/without cache" + (let () + (define no-cache + (fold-available-packages (lambda* (name version result #:rest rest) + (cons (cons* name version rest) + result)) + '())) + + (define from-cache + (call-with-temporary-directory + (lambda (cache) + (generate-package-cache cache) + (mock ((guix describe) current-profile (const cache)) + (mock ((gnu packages) cache-is-authoritative? (const #t)) + (fold-available-packages (lambda* (name version result + #:rest rest) + (cons (cons* name version rest) + result)) + '())))))) + + (lset= equal? no-cache from-cache))) + (test-assert "find-packages-by-name" (match (find-packages-by-name "hello") (((? (cut eq? hello <>))) #t) @@ -1005,6 +1027,24 @@ (((? (cut eq? hello <>))) #t) (wrong (pk 'find-packages-by-name wrong #f)))) +(test-equal "find-packages-by-name with cache" + (find-packages-by-name "guile") + (call-with-temporary-directory + (lambda (cache) + (generate-package-cache cache) + (mock ((guix describe) current-profile (const cache)) + (mock ((gnu packages) cache-is-authoritative? (const #t)) + (find-packages-by-name "guile")))))) + +(test-equal "find-packages-by-name + version, with cache" + (find-packages-by-name "guile" "2") + (call-with-temporary-directory + (lambda (cache) + (generate-package-cache cache) + (mock ((guix describe) current-profile (const cache)) + (mock ((gnu packages) cache-is-authoritative? (const #t)) + (find-packages-by-name "guile" "2")))))) + (test-assert "--search-paths with pattern" ;; Make sure 'guix package --search-paths' correctly reports environment ;; variables when file patterns are used (in particular, it must follow @@ -1113,6 +1153,29 @@ (lambda (key . args) key))) +(test-equal "find-package-locations" + (map (lambda (package) + (cons (package-version package) + (package-location package))) + (find-packages-by-name "guile")) + (find-package-locations "guile")) + +(test-equal "find-package-locations with cache" + (map (lambda (package) + (cons (package-version package) + (package-location package))) + (find-packages-by-name "guile")) + (call-with-temporary-directory + (lambda (cache) + (generate-package-cache cache) + (mock ((guix describe) current-profile (const cache)) + (mock ((gnu packages) cache-is-authoritative? (const #t)) + (find-package-locations "guile")))))) + +(test-equal "specification->location" + (package-location (specification->package "guile@2")) + (specification->location "guile@2")) + (test-end "packages") ;;; Local Variables: diff --git a/tests/profiles.scm b/tests/profiles.scm index 1f9bbd099d..9a05030aff 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 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Alex Kost <alezost@gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -330,7 +330,7 @@ (test-assert "package->manifest-entry, search paths" ;; See <http://bugs.gnu.org/22073>. - (let ((mpl (@ (gnu packages python) python2-matplotlib))) + (let ((mpl (@ (gnu packages python-xyz) python2-matplotlib))) (lset= eq? (package-transitive-native-search-paths mpl) (manifest-entry-search-paths @@ -591,6 +591,36 @@ (built-derivations (list drv)) (return (readlink (readlink (string-append profile "/dangling"))))))) +(test-equalm "profile in profile" + '("foo" "0") + + ;; Make sure we can build a profile that has another profile has one of its + ;; entries. The new profile's /manifest and /etc/profile must override the + ;; other's. + (mlet* %store-monad + ((prof0 (profile-derivation + (manifest + (list (package->manifest-entry %bootstrap-guile))) + #:hooks '() + #:locales? #f)) + (prof1 (profile-derivation + (manifest (list (manifest-entry + (name "foo") + (version "0") + (item prof0)))) + #:hooks '() + #:locales? #f))) + (mbegin %store-monad + (built-derivations (list prof1)) + (let ((out (derivation->output-path prof1))) + (return (and (file-exists? + (string-append out "/bin/guile")) + (let ((manifest (profile-manifest out))) + (match (manifest-entries manifest) + ((entry) + (list (manifest-entry-name entry) + (manifest-entry-version entry))))))))))) + (test-end "profiles") ;;; Local Variables: |