From 7ca87354db53fd1e1a7a3dfeddb9a598ea064bbe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 4 Sep 2016 23:41:53 +0200 Subject: Add (guix modules). * guix/modules.scm, tests/modules.scm: New files. * Makefile.am (MODULES, SCM_TESTS): Add them. * doc/guix.texi (G-Expressions): Add an example of 'source-module-closure'. --- tests/modules.scm | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 tests/modules.scm (limited to 'tests') diff --git a/tests/modules.scm b/tests/modules.scm new file mode 100644 index 0000000000..04945e531b --- /dev/null +++ b/tests/modules.scm @@ -0,0 +1,45 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 Ludovic Courtès +;;; +;;; 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-modules) + #:use-module (guix modules) + #:use-module ((guix build-system gnu) #:select (%gnu-build-system-modules)) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64)) + +(test-begin "modules") + +(test-assert "closure of (guix build gnu-build-system)" + (lset= equal? + (live-module-closure '((guix build gnu-build-system))) + (source-module-closure '((guix build gnu-build-system))) + %gnu-build-system-modules + (source-module-closure %gnu-build-system-modules) + (live-module-closure %gnu-build-system-modules))) + +(test-assert "closure of (gnu build install)" + (lset= equal? + (live-module-closure '((gnu build install))) + (source-module-closure '((gnu build install))))) + +(test-assert "closure of (gnu build vm)" + (lset= equal? + (live-module-closure '((gnu build vm))) + (source-module-closure '((gnu build vm))))) + +(test-end) -- cgit v1.2.3 From c8c25704aeb2e5fa4feb6a86235f9565738eea99 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 6 Sep 2016 20:19:21 +0200 Subject: profiles: Add manifest-transaction helper procedures. * guix/profiles.scm (manifest-transaction-install-entry) (manifest-transaction-remove-pattern) (manifest-transaction-null?): New procedures. * tests/profiles.scm ("manifest-transaction-null?"): New test. --- tests/profiles.scm | 3 +++ 1 file changed, 3 insertions(+) (limited to 'tests') diff --git a/tests/profiles.scm b/tests/profiles.scm index 028d7b6fb4..f9c2f5499e 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -187,6 +187,9 @@ (and (null? remove) (null? install) (null? downgrade) (equal? (list (cons guile-2.0.9 guile-2.0.9)) upgrade))))) +(test-assert "manifest-transaction-null?" + (manifest-transaction-null? (manifest-transaction))) + (test-assertm "profile-derivation" (mlet* %store-monad ((entry -> (package->manifest-entry %bootstrap-guile)) -- cgit v1.2.3 From 5239f3d90841de767c86d0f3a7975b8d799d583d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 6 Sep 2016 22:28:12 +0200 Subject: guix package: Build up the transaction incrementally. * guix/scripts/package.scm (upgraded-manifest-entry): Rename to... (transaction-upgrade-entry): ... this. Add 'transaction' parameter and return a transaction. (options->installable): Likewise. [to-upgrade]: Rename to... [upgraded]: ... this, and change to be a transaction. Return a transaction. (options->removable): Likewise. (process-actions): Adjust accordingly. * tests/packages.scm ("transaction-upgrade-entry, zero upgrades") ("transaction-upgrade-entry, one upgrade"): New tests. --- tests/packages.scm | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) (limited to 'tests') diff --git a/tests/packages.scm b/tests/packages.scm index daceea5d62..456e691962 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -49,6 +49,7 @@ #:use-module (srfi srfi-35) #:use-module (srfi srfi-64) #:use-module (rnrs io ports) + #:use-module (ice-9 vlist) #:use-module (ice-9 regex) #:use-module (ice-9 match)) @@ -83,6 +84,34 @@ (and (hidden-package? (hidden-package (dummy-package "foo"))) (not (hidden-package? (dummy-package "foo"))))) +(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)) + ((@@ (guix scripts package) transaction-upgrade-entry) + (manifest-entry + (inherit (package->manifest-entry old)) + (item (string-append (%store-prefix) "/" + (make-string 32 #\e) "-foo-1"))) + (manifest-transaction))))) + (manifest-transaction-null? tx))) + +(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))) + ((@@ (guix scripts package) transaction-upgrade-entry) + (manifest-entry + (inherit (package->manifest-entry old)) + (item (string-append (%store-prefix) "/" + (make-string 32 #\e) "-foo-1"))) + (manifest-transaction))))) + (and (match (manifest-transaction-install tx) + ((($ "foo" "2" "out" item)) + (eq? item new))) + (null? (manifest-transaction-remove tx))))) + (test-assert "package-field-location" (let () (define (goto port line column) -- cgit v1.2.3 From 01afdab89c6a91f4cd05d3c4f4ff95a0402703eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 6 Sep 2016 23:14:07 +0200 Subject: packages: Add 'package-superseded' and associated support. This provides a way to mark a package as superseded by another one. Upgrades replace superseded packages with their replacement. * guix/packages.scm (package-superseded, deprecated-package): New procedures. * gnu/packages.scm (%find-package): Check for 'package-superseded'. * guix/scripts/package.scm (transaction-upgrade-entry)[supersede]: New procedure. Call it when 'package-superseded' is true. * tests/guix-build.sh: Add test for a superseded package. * tests/packages.scm ("package-superseded") ("transaction-upgrade-entry, superseded package"): New tests. --- tests/guix-build.sh | 6 ++++++ tests/packages.scm | 30 ++++++++++++++++++++++++++++++ 2 files changed, 36 insertions(+) (limited to 'tests') diff --git a/tests/guix-build.sh b/tests/guix-build.sh index 6d4f97019a..9e9788bca0 100644 --- a/tests/guix-build.sh +++ b/tests/guix-build.sh @@ -93,6 +93,9 @@ cat > "$module_dir/foo.scm"<package "foo") + (and (eq? new (specification->package "foo")) + (eq? new (specification->package+output "foo"))))))) + (test-assert "transaction-upgrade-entry, zero upgrades" (let* ((old (dummy-package "foo" (version "1"))) (tx (mock ((gnu packages) find-newest-available-packages @@ -112,6 +121,27 @@ (eq? item new))) (null? (manifest-transaction-remove tx))))) +(test-assert "transaction-upgrade-entry, superseded package" + (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))) + ((@@ (guix scripts package) transaction-upgrade-entry) + (manifest-entry + (inherit (package->manifest-entry old)) + (item (string-append (%store-prefix) "/" + (make-string 32 #\e) "-foo-1"))) + (manifest-transaction))))) + (and (match (manifest-transaction-install tx) + ((($ "bar" "2" "out" item)) + (eq? item new))) + (match (manifest-transaction-remove tx) + (((? manifest-pattern? pattern)) + (and (string=? (manifest-pattern-name pattern) "foo") + (string=? (manifest-pattern-version pattern) "1") + (string=? (manifest-pattern-output pattern) "out"))))))) + (test-assert "package-field-location" (let () (define (goto port line column) -- cgit v1.2.3 From 392a4e122350367c4b4ac331db5ec28360c7f38c Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Tue, 6 Sep 2016 08:28:33 +0200 Subject: guix hash: Add --exclude-vcs option. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/hash.scm (show-help): Add help text for --exclude-vcs option. (%options): Add --exclude-vcs option. (guix-hash): Handle exclude-vcs option. * doc/guix.texi ("Invoking guix hash"): Update doc. * tests/guix-hash.sh: Add test. Co-authored-by: Ludovic Courtès --- tests/guix-hash.sh | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) (limited to 'tests') diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh index 23df01d417..44213d51af 100644 --- a/tests/guix-hash.sh +++ b/tests/guix-hash.sh @@ -1,5 +1,6 @@ # GNU Guix --- Functional package management for GNU # Copyright © 2013, 2014 Ludovic Courtès +# Copyright © 2016 Jan Nieuwenhuizen # # This file is part of GNU Guix. # @@ -46,3 +47,18 @@ then false; else true; fi # the archive format doesn't support. if guix hash -r /dev/null then false; else true; fi + +# Adding a .git directory +mkdir "$tmpdir/.git" +touch "$tmpdir/.git/foo" + +# ...changes the hash +test `guix hash -r $tmpdir` = 0a50z04zyzf7pidwxv0nwbj82pgzbrhdy9562kncnvkcfvb48m59 + +# ...but remains the same when using `-x' +test `guix hash -r $tmpdir -x` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p + +# Without '-r', this should fail. +if guix hash "$tmpdir" +then false; else true; fi + -- cgit v1.2.3 From a9e5e92f940381e3a4ee828c6d8ff22a73067e17 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 9 Sep 2016 22:46:36 +0200 Subject: gexp: Add 'file-append'. * guix/gexp.scm (): New record type. (file-append): New procedure. (file-append-compiler): New gexp compiler. * tests/gexp.scm ("file-append", "file-append, output") ("file-append, nested", "gexp->file + file-append"): New tests. * doc/guix.texi (G-Expressions): Use it in 'nscd' and 'list-files' examples. Document 'file-append'. --- tests/gexp.scm | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) (limited to 'tests') diff --git a/tests/gexp.scm b/tests/gexp.scm index 03a64fa6bb..214e7a5302 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -207,6 +207,47 @@ (e3 `(display ,txt))) (equal? `(begin ,e0 ,e1 ,e2 ,e3) (gexp->sexp* exp)))))) +(test-assert "file-append" + (let* ((drv (package-derivation %store %bootstrap-guile)) + (fa (file-append %bootstrap-guile "/bin/guile")) + (exp #~(here we go #$fa))) + (and (match (gexp->sexp* exp) + (('here 'we 'go (? string? result)) + (string=? result + (string-append (derivation->output-path drv) + "/bin/guile")))) + (match (gexp-inputs exp) + (((thing "out")) + (eq? thing fa)))))) + +(test-assert "file-append, output" + (let* ((drv (package-derivation %store glibc)) + (fa (file-append glibc "/lib" "/debug")) + (exp #~(foo #$fa:debug))) + (and (match (gexp->sexp* exp) + (('foo (? string? result)) + (string=? result + (string-append (derivation->output-path drv "debug") + "/lib/debug")))) + (match (gexp-inputs exp) + (((thing "debug")) + (eq? thing fa)))))) + +(test-assert "file-append, nested" + (let* ((drv (package-derivation %store glibc)) + (dir (file-append glibc "/bin")) + (slash (file-append dir "/")) + (file (file-append slash "getent")) + (exp #~(foo #$file))) + (and (match (gexp->sexp* exp) + (('foo (? string? result)) + (string=? result + (string-append (derivation->output-path drv) + "/bin/getent")))) + (match (gexp-inputs exp) + (((thing "out")) + (eq? thing file)))))) + (test-assert "ungexp + ungexp-native" (let* ((exp (gexp (list (ungexp-native %bootstrap-guile) (ungexp coreutils) @@ -338,6 +379,18 @@ (return (and (equal? sexp (call-with-input-file out read)) (equal? (list guile) refs))))) +(test-assertm "gexp->file + file-append" + (mlet* %store-monad ((exp -> #~#$(file-append %bootstrap-guile + "/bin/guile")) + (guile (package-file %bootstrap-guile)) + (drv (gexp->file "foo" exp)) + (out -> (derivation->output-path drv)) + (done (built-derivations (list drv))) + (refs ((store-lift references) out))) + (return (and (equal? (string-append guile "/bin/guile") + (call-with-input-file out read)) + (equal? (list guile) refs))))) + (test-assertm "gexp->derivation" (mlet* %store-monad ((file (text-file "foo" "Hello, world!")) (exp -> (gexp -- cgit v1.2.3 From 11e296ef3092de1e5b659822d4dad4465abad34f Mon Sep 17 00:00:00 2001 From: David Craven Date: Thu, 22 Sep 2016 11:35:13 +0200 Subject: import: utils: Refactor license->symbol. * guix/import/utils.scm (license->symbol): Work for all licenses. * tests/import-utils.scm (license->symbol): Add test. --- tests/import-utils.scm | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'tests') diff --git a/tests/import-utils.scm b/tests/import-utils.scm index 3b11875c4a..8d44b9e0e2 100644 --- a/tests/import-utils.scm +++ b/tests/import-utils.scm @@ -20,6 +20,7 @@ (define-module (test-import-utils) #:use-module (guix tests) #:use-module (guix import utils) + #:use-module ((guix licenses) #:prefix license:) #:use-module (srfi srfi-64)) (test-begin "import-utils") @@ -33,4 +34,8 @@ "This package provides a function to establish world peace" (beautify-description "A function to establish world peace")) +(test-equal "license->symbol" + 'license:lgpl2.0 + (license->symbol license:lgpl2.0)) + (test-end "import-utils") -- cgit v1.2.3