2013-01-05 23:47:50 +00:00
|
|
|
|
;;; GNU Guix --- Functional package management for GNU
|
2021-02-01 15:07:18 +00:00
|
|
|
|
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
|
2018-09-23 06:04:19 +00:00
|
|
|
|
;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
2012-06-27 23:24:34 +00:00
|
|
|
|
;;;
|
2013-01-05 23:47:50 +00:00
|
|
|
|
;;; This file is part of GNU Guix.
|
2012-06-27 23:24:34 +00:00
|
|
|
|
;;;
|
2013-01-05 23:47:50 +00:00
|
|
|
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
2012-06-27 23:24:34 +00:00
|
|
|
|
;;; 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.
|
|
|
|
|
|
;;;
|
2013-01-05 23:47:50 +00:00
|
|
|
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
2012-06-27 23:24:34 +00:00
|
|
|
|
;;; 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
|
2013-01-05 23:47:50 +00:00
|
|
|
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
2012-06-27 23:24:34 +00:00
|
|
|
|
|
|
|
|
|
|
(define-module (test-packages)
|
2014-08-23 17:18:01 +00:00
|
|
|
|
#:use-module (guix tests)
|
2012-06-27 23:24:34 +00:00
|
|
|
|
#:use-module (guix store)
|
2015-01-03 18:46:07 +00:00
|
|
|
|
#:use-module (guix monads)
|
2016-03-04 22:01:47 +00:00
|
|
|
|
#:use-module (guix grafts)
|
2016-06-15 08:38:46 +00:00
|
|
|
|
#:use-module ((guix gexp) #:select (local-file local-file-file))
|
2020-07-24 20:58:08 +00:00
|
|
|
|
#:use-module (guix utils)
|
|
|
|
|
|
#:use-module ((guix diagnostics)
|
2014-10-08 21:06:19 +00:00
|
|
|
|
;; Rename the 'location' binding to allow proper syntax
|
|
|
|
|
|
;; matching when setting the 'location' field of a package.
|
|
|
|
|
|
#:renamer (lambda (name)
|
|
|
|
|
|
(cond ((eq? name 'location) 'make-location)
|
|
|
|
|
|
(else name))))
|
2020-05-23 13:45:22 +00:00
|
|
|
|
#:use-module ((gcrypt hash) #:prefix gcrypt:)
|
2012-06-27 23:24:34 +00:00
|
|
|
|
#:use-module (guix derivations)
|
|
|
|
|
|
#:use-module (guix packages)
|
2016-02-22 15:29:44 +00:00
|
|
|
|
#:use-module (guix grafts)
|
2015-12-20 13:34:36 +00:00
|
|
|
|
#:use-module (guix search-paths)
|
2013-03-30 21:56:38 +00:00
|
|
|
|
#:use-module (guix build-system)
|
2012-09-10 20:47:10 +00:00
|
|
|
|
#:use-module (guix build-system trivial)
|
2012-07-07 18:14:20 +00:00
|
|
|
|
#:use-module (guix build-system gnu)
|
packages: 'package-input-rewriting/spec' can rewrite implicit dependencies.
With this change, '--with-input', '--with-graft', etc. also apply to
implicit dependencies. Thus, it's now possible to do:
guix build python-itsdangerous --with-input=python-wrapper=python@2
or:
guix build hello --with-graft=glibc=glibc@2.29
Additionally, before, implicit inputs were not rewritten, which could
lead to duplicates in the output of 'bag-transitive-inputs' (packages
that are not 'eq?' but lead to the same derivation). This in turn would
lead to unnecessary rebuilds when using '--with-input' & co. This
change fixes it by ensuring even implicit inputs are rewritten.
Fixes <https://bugs.gnu.org/42156>.
* guix/packages.scm (package-input-rewriting/spec): Add #:deep?
defaulting to #true, and pass it to 'package-mapping'.
[replacement-property]: New variable.
[rewrite]: Check that property and set it on the result of PROC.
[cut?]: New procedure.
* tests/packages.scm ("package-input-rewriting/spec"): Ensure implicit
inputs were unchanged.
("package-input-rewriting/spec, partial match"): Pass #:deep? #f.
("package-input-rewriting/spec, deep")
("package-input-rewriting/spec, no duplicates"): New tests.
(package/inherit): Move before use.
* tests/guix-build.sh: Add tests.
* tests/scripts-build.scm ("options->transformation, with-graft"):
Compare dependencies by package name or derivation file name.
* doc/guix.texi (Defining Packages): Adjust accordingly.
2020-09-23 08:29:09 +00:00
|
|
|
|
#:use-module (guix build-system python)
|
2018-09-23 06:04:19 +00:00
|
|
|
|
#:use-module (guix memoization)
|
2015-01-03 18:46:07 +00:00
|
|
|
|
#:use-module (guix profiles)
|
|
|
|
|
|
#:use-module (guix scripts package)
|
2021-02-01 15:07:18 +00:00
|
|
|
|
#:use-module (guix sets)
|
2013-01-18 00:06:47 +00:00
|
|
|
|
#:use-module (gnu packages)
|
2013-01-18 00:06:24 +00:00
|
|
|
|
#:use-module (gnu packages base)
|
packages: Implement grafts.
Thanks to Mark H. Weaver <mhw@netris.org> for insightful discussions
and suggestions.
* guix/packages.scm (<package>)[graft]: New field.
(patch-and-repack): Invoke 'package-derivation' with #:graft? #f.
(package-source-derivation): Likewise. Do not use (%guile-for-build)
in call to 'patch-and-repack', and we could end up using a grafted
Guile.
(expand-input): Likewise, also for 'package-cross-derivation' call.
(package->bag): Add #:graft? parameter. Honor it. Use 'strip-append'
instead of 'package-full-name'.
(input-graft, input-cross-graft, bag-grafts, package-grafts): New
procedures.
(package-derivation, package-cross-derivation): Add #:graft? parameter
and honor it.
* gnu/packages/bootstrap.scm (package-with-bootstrap-guile): Add
recursive call on 'graft'.
* guix/build-system/gnu.scm (package-with-explicit-inputs,
package-with-extra-configure-variable, static-package): Likewise.
(gnu-build): Use the ungrafted Guile to avoid full rebuilds.
(gnu-cross-build): Likewise.
* guix/build-system/cmake.scm (cmake-build): Likewise.
* guix/build-system/glib-or-gtk.scm (glib-or-gtk-build): Likewise.
* guix/build-system/perl.scm (perl-build): Likewise.
* guix/build-system/python.scm (python-build): Likewise.
* guix/build-system/ruby.scm (ruby-build): Likewise.
* guix/build-system/trivial.scm (guile-for-build): Likewise.
* tests/packages.scm ("package-derivation, direct graft",
"package-cross-derivation, direct graft", "package-grafts,
indirect grafts", "package-grafts, indirect grafts, cross",
"package-grafts, indirect grafts, propagated inputs",
"package-derivation, indirect grafts"): New tests.
("bag->derivation", "bag->derivation, cross-compilation"): Wrap in
'parameterize'.
* doc/guix.texi (Security Updates): New node.
(Invoking guix build): Document --no-graft.
2014-10-27 17:09:00 +00:00
|
|
|
|
#:use-module (gnu packages guile)
|
2013-01-18 00:06:24 +00:00
|
|
|
|
#:use-module (gnu packages bootstrap)
|
packages: 'package-input-rewriting/spec' can rewrite implicit dependencies.
With this change, '--with-input', '--with-graft', etc. also apply to
implicit dependencies. Thus, it's now possible to do:
guix build python-itsdangerous --with-input=python-wrapper=python@2
or:
guix build hello --with-graft=glibc=glibc@2.29
Additionally, before, implicit inputs were not rewritten, which could
lead to duplicates in the output of 'bag-transitive-inputs' (packages
that are not 'eq?' but lead to the same derivation). This in turn would
lead to unnecessary rebuilds when using '--with-input' & co. This
change fixes it by ensuring even implicit inputs are rewritten.
Fixes <https://bugs.gnu.org/42156>.
* guix/packages.scm (package-input-rewriting/spec): Add #:deep?
defaulting to #true, and pass it to 'package-mapping'.
[replacement-property]: New variable.
[rewrite]: Check that property and set it on the result of PROC.
[cut?]: New procedure.
* tests/packages.scm ("package-input-rewriting/spec"): Ensure implicit
inputs were unchanged.
("package-input-rewriting/spec, partial match"): Pass #:deep? #f.
("package-input-rewriting/spec, deep")
("package-input-rewriting/spec, no duplicates"): New tests.
(package/inherit): Move before use.
* tests/guix-build.sh: Add tests.
* tests/scripts-build.scm ("options->transformation, with-graft"):
Compare dependencies by package name or derivation file name.
* doc/guix.texi (Defining Packages): Adjust accordingly.
2020-09-23 08:29:09 +00:00
|
|
|
|
#:use-module (gnu packages python)
|
2017-01-22 21:42:57 +00:00
|
|
|
|
#:use-module (gnu packages version-control)
|
2015-01-03 18:46:07 +00:00
|
|
|
|
#:use-module (gnu packages xml)
|
packages: Implement grafts.
Thanks to Mark H. Weaver <mhw@netris.org> for insightful discussions
and suggestions.
* guix/packages.scm (<package>)[graft]: New field.
(patch-and-repack): Invoke 'package-derivation' with #:graft? #f.
(package-source-derivation): Likewise. Do not use (%guile-for-build)
in call to 'patch-and-repack', and we could end up using a grafted
Guile.
(expand-input): Likewise, also for 'package-cross-derivation' call.
(package->bag): Add #:graft? parameter. Honor it. Use 'strip-append'
instead of 'package-full-name'.
(input-graft, input-cross-graft, bag-grafts, package-grafts): New
procedures.
(package-derivation, package-cross-derivation): Add #:graft? parameter
and honor it.
* gnu/packages/bootstrap.scm (package-with-bootstrap-guile): Add
recursive call on 'graft'.
* guix/build-system/gnu.scm (package-with-explicit-inputs,
package-with-extra-configure-variable, static-package): Likewise.
(gnu-build): Use the ungrafted Guile to avoid full rebuilds.
(gnu-cross-build): Likewise.
* guix/build-system/cmake.scm (cmake-build): Likewise.
* guix/build-system/glib-or-gtk.scm (glib-or-gtk-build): Likewise.
* guix/build-system/perl.scm (perl-build): Likewise.
* guix/build-system/python.scm (python-build): Likewise.
* guix/build-system/ruby.scm (ruby-build): Likewise.
* guix/build-system/trivial.scm (guile-for-build): Likewise.
* tests/packages.scm ("package-derivation, direct graft",
"package-cross-derivation, direct graft", "package-grafts,
indirect grafts", "package-grafts, indirect grafts, cross",
"package-grafts, indirect grafts, propagated inputs",
"package-derivation, indirect grafts"): New tests.
("bag->derivation", "bag->derivation, cross-compilation"): Wrap in
'parameterize'.
* doc/guix.texi (Security Updates): New node.
(Invoking guix build): Document --no-graft.
2014-10-27 17:09:00 +00:00
|
|
|
|
#:use-module (srfi srfi-1)
|
2012-06-30 14:37:19 +00:00
|
|
|
|
#:use-module (srfi srfi-26)
|
2013-05-27 21:41:35 +00:00
|
|
|
|
#:use-module (srfi srfi-34)
|
2015-01-20 09:17:24 +00:00
|
|
|
|
#:use-module (srfi srfi-35)
|
2012-06-30 14:37:19 +00:00
|
|
|
|
#:use-module (srfi srfi-64)
|
2021-02-01 15:07:18 +00:00
|
|
|
|
#:use-module (srfi srfi-71)
|
2020-05-19 13:55:08 +00:00
|
|
|
|
#:use-module (rnrs bytevectors)
|
2012-12-04 22:46:50 +00:00
|
|
|
|
#:use-module (rnrs io ports)
|
2016-09-06 20:28:12 +00:00
|
|
|
|
#:use-module (ice-9 vlist)
|
2014-10-08 21:06:19 +00:00
|
|
|
|
#:use-module (ice-9 regex)
|
2012-06-30 14:37:19 +00:00
|
|
|
|
#:use-module (ice-9 match))
|
2012-06-27 23:24:34 +00:00
|
|
|
|
|
|
|
|
|
|
;; Test the high-level packaging layer.
|
|
|
|
|
|
|
|
|
|
|
|
(define %store
|
2014-08-23 17:18:01 +00:00
|
|
|
|
(open-connection-for-tests))
|
2012-06-27 23:24:34 +00:00
|
|
|
|
|
2016-03-04 23:06:15 +00:00
|
|
|
|
;; Globally disable grafting to avoid rebuilding the world ('graft-derivation'
|
|
|
|
|
|
;; can trigger builds early.)
|
|
|
|
|
|
(%graft? #f)
|
|
|
|
|
|
|
packages: Implement grafts.
Thanks to Mark H. Weaver <mhw@netris.org> for insightful discussions
and suggestions.
* guix/packages.scm (<package>)[graft]: New field.
(patch-and-repack): Invoke 'package-derivation' with #:graft? #f.
(package-source-derivation): Likewise. Do not use (%guile-for-build)
in call to 'patch-and-repack', and we could end up using a grafted
Guile.
(expand-input): Likewise, also for 'package-cross-derivation' call.
(package->bag): Add #:graft? parameter. Honor it. Use 'strip-append'
instead of 'package-full-name'.
(input-graft, input-cross-graft, bag-grafts, package-grafts): New
procedures.
(package-derivation, package-cross-derivation): Add #:graft? parameter
and honor it.
* gnu/packages/bootstrap.scm (package-with-bootstrap-guile): Add
recursive call on 'graft'.
* guix/build-system/gnu.scm (package-with-explicit-inputs,
package-with-extra-configure-variable, static-package): Likewise.
(gnu-build): Use the ungrafted Guile to avoid full rebuilds.
(gnu-cross-build): Likewise.
* guix/build-system/cmake.scm (cmake-build): Likewise.
* guix/build-system/glib-or-gtk.scm (glib-or-gtk-build): Likewise.
* guix/build-system/perl.scm (perl-build): Likewise.
* guix/build-system/python.scm (python-build): Likewise.
* guix/build-system/ruby.scm (ruby-build): Likewise.
* guix/build-system/trivial.scm (guile-for-build): Likewise.
* tests/packages.scm ("package-derivation, direct graft",
"package-cross-derivation, direct graft", "package-grafts,
indirect grafts", "package-grafts, indirect grafts, cross",
"package-grafts, indirect grafts, propagated inputs",
"package-derivation, indirect grafts"): New tests.
("bag->derivation", "bag->derivation, cross-compilation"): Wrap in
'parameterize'.
* doc/guix.texi (Security Updates): New node.
(Invoking guix build): Document --no-graft.
2014-10-27 17:09:00 +00:00
|
|
|
|
|
|
|
|
|
|
(test-begin "packages")
|
|
|
|
|
|
|
2014-10-08 21:06:19 +00:00
|
|
|
|
(test-assert "printer with location"
|
2016-01-24 16:42:39 +00:00
|
|
|
|
(string-match "^#<package foo@0 foo.scm:42 [[:xdigit:]]+>$"
|
2014-10-08 21:06:19 +00:00
|
|
|
|
(with-output-to-string
|
|
|
|
|
|
(lambda ()
|
|
|
|
|
|
(write
|
|
|
|
|
|
(dummy-package "foo"
|
|
|
|
|
|
(location (make-location "foo.scm" 42 7))))))))
|
|
|
|
|
|
|
|
|
|
|
|
(test-assert "printer without location"
|
2016-01-24 16:42:39 +00:00
|
|
|
|
(string-match "^#<package foo@0 [[:xdigit:]]+>$"
|
2014-10-08 21:06:19 +00:00
|
|
|
|
(with-output-to-string
|
|
|
|
|
|
(lambda ()
|
|
|
|
|
|
(write
|
|
|
|
|
|
(dummy-package "foo" (location #f)))))))
|
|
|
|
|
|
|
2016-07-28 16:50:43 +00:00
|
|
|
|
(test-assert "hidden-package"
|
|
|
|
|
|
(and (hidden-package? (hidden-package (dummy-package "foo")))
|
|
|
|
|
|
(not (hidden-package? (dummy-package "foo")))))
|
|
|
|
|
|
|
2016-09-06 21:14:07 +00:00
|
|
|
|
(test-assert "package-superseded"
|
|
|
|
|
|
(let* ((new (dummy-package "bar"))
|
|
|
|
|
|
(old (deprecated-package "foo" new)))
|
|
|
|
|
|
(and (eq? (package-superseded old) new)
|
|
|
|
|
|
(mock ((gnu packages) find-best-packages-by-name (const (list old)))
|
|
|
|
|
|
(specification->package "foo")
|
|
|
|
|
|
(and (eq? new (specification->package "foo"))
|
|
|
|
|
|
(eq? new (specification->package+output "foo")))))))
|
|
|
|
|
|
|
2016-09-06 20:28:12 +00:00
|
|
|
|
(test-assert "transaction-upgrade-entry, zero upgrades"
|
|
|
|
|
|
(let* ((old (dummy-package "foo" (version "1")))
|
2019-01-11 14:17:10 +00:00
|
|
|
|
(tx (mock ((gnu packages) find-best-packages-by-name
|
|
|
|
|
|
(const '()))
|
2020-01-16 09:57:19 +00:00
|
|
|
|
(transaction-upgrade-entry
|
|
|
|
|
|
#f ;no store access needed
|
2016-09-06 20:28:12 +00:00
|
|
|
|
(manifest-entry
|
|
|
|
|
|
(inherit (package->manifest-entry old))
|
|
|
|
|
|
(item (string-append (%store-prefix) "/"
|
|
|
|
|
|
(make-string 32 #\e) "-foo-1")))
|
|
|
|
|
|
(manifest-transaction)))))
|
|
|
|
|
|
(manifest-transaction-null? tx)))
|
|
|
|
|
|
|
2020-03-30 21:19:38 +00:00
|
|
|
|
(test-assert "transaction-upgrade-entry, zero upgrades, equivalent package"
|
|
|
|
|
|
(let* ((old (dummy-package "foo" (version "1")))
|
|
|
|
|
|
(drv (package-derivation %store old))
|
|
|
|
|
|
(tx (mock ((gnu packages) find-best-packages-by-name
|
|
|
|
|
|
(const (list old)))
|
|
|
|
|
|
(transaction-upgrade-entry
|
|
|
|
|
|
%store
|
|
|
|
|
|
(manifest-entry
|
|
|
|
|
|
(inherit (package->manifest-entry old))
|
|
|
|
|
|
(item (derivation->output-path drv)))
|
|
|
|
|
|
(manifest-transaction)))))
|
|
|
|
|
|
(manifest-transaction-null? tx)))
|
|
|
|
|
|
|
2020-03-30 21:34:48 +00:00
|
|
|
|
(test-assert "transaction-upgrade-entry, zero upgrades, propagated inputs"
|
|
|
|
|
|
;; Properly detect equivalent packages even when they have propagated
|
|
|
|
|
|
;; inputs. See <https://bugs.gnu.org/35872>.
|
|
|
|
|
|
(let* ((dep (dummy-package "dep" (version "2")))
|
|
|
|
|
|
(old (dummy-package "foo" (version "1")
|
|
|
|
|
|
(propagated-inputs `(("dep" ,dep)))))
|
|
|
|
|
|
(drv (package-derivation %store old))
|
|
|
|
|
|
(tx (mock ((gnu packages) find-best-packages-by-name
|
|
|
|
|
|
(const (list old)))
|
|
|
|
|
|
(transaction-upgrade-entry
|
|
|
|
|
|
%store
|
|
|
|
|
|
(manifest-entry
|
|
|
|
|
|
(inherit (package->manifest-entry old))
|
|
|
|
|
|
(item (derivation->output-path drv))
|
|
|
|
|
|
(dependencies
|
|
|
|
|
|
(list (manifest-entry
|
|
|
|
|
|
(inherit (package->manifest-entry dep))
|
|
|
|
|
|
(item (derivation->output-path
|
|
|
|
|
|
(package-derivation %store dep)))))))
|
|
|
|
|
|
(manifest-transaction)))))
|
|
|
|
|
|
(manifest-transaction-null? tx)))
|
|
|
|
|
|
|
2016-09-06 20:28:12 +00:00
|
|
|
|
(test-assert "transaction-upgrade-entry, one upgrade"
|
|
|
|
|
|
(let* ((old (dummy-package "foo" (version "1")))
|
|
|
|
|
|
(new (dummy-package "foo" (version "2")))
|
2019-01-11 14:17:10 +00:00
|
|
|
|
(tx (mock ((gnu packages) find-best-packages-by-name
|
|
|
|
|
|
(const (list new)))
|
2020-01-16 09:57:19 +00:00
|
|
|
|
(transaction-upgrade-entry
|
|
|
|
|
|
#f ;no store access needed
|
2016-09-06 20:28:12 +00:00
|
|
|
|
(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)
|
|
|
|
|
|
((($ <manifest-entry> "foo" "2" "out" item))
|
|
|
|
|
|
(eq? item new)))
|
|
|
|
|
|
(null? (manifest-transaction-remove tx)))))
|
|
|
|
|
|
|
2016-09-06 21:14:07 +00:00
|
|
|
|
(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))
|
2019-01-11 14:17:10 +00:00
|
|
|
|
(tx (mock ((gnu packages) find-best-packages-by-name
|
|
|
|
|
|
(const (list dep)))
|
2020-01-16 09:57:19 +00:00
|
|
|
|
(transaction-upgrade-entry
|
|
|
|
|
|
#f ;no store access needed
|
2016-09-06 21:14:07 +00:00
|
|
|
|
(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)
|
|
|
|
|
|
((($ <manifest-entry> "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")))))))
|
|
|
|
|
|
|
2020-09-25 15:16:34 +00:00
|
|
|
|
(test-equal "transaction-upgrade-entry, transformation options preserved"
|
|
|
|
|
|
(derivation-file-name (package-derivation %store grep))
|
|
|
|
|
|
|
|
|
|
|
|
(let* ((old (dummy-package "emacs" (version "1")))
|
|
|
|
|
|
(props '((transformations . ((with-input . "emacs=grep")))))
|
|
|
|
|
|
(tx (transaction-upgrade-entry
|
|
|
|
|
|
%store
|
|
|
|
|
|
(manifest-entry
|
|
|
|
|
|
(inherit (package->manifest-entry old))
|
|
|
|
|
|
(properties props)
|
|
|
|
|
|
(item (string-append (%store-prefix) "/"
|
|
|
|
|
|
(make-string 32 #\e) "-foo-1")))
|
|
|
|
|
|
(manifest-transaction))))
|
|
|
|
|
|
(match (manifest-transaction-install tx)
|
|
|
|
|
|
(((? manifest-entry? entry))
|
|
|
|
|
|
(and (string=? (manifest-entry-version entry)
|
|
|
|
|
|
(package-version grep))
|
|
|
|
|
|
(string=? (manifest-entry-name entry)
|
|
|
|
|
|
(package-name grep))
|
|
|
|
|
|
(equal? (manifest-entry-properties entry) props)
|
|
|
|
|
|
(derivation-file-name
|
|
|
|
|
|
(package-derivation %store (manifest-entry-item entry))))))))
|
|
|
|
|
|
|
2020-03-30 20:11:54 +00:00
|
|
|
|
(test-assert "transaction-upgrade-entry, grafts"
|
|
|
|
|
|
;; Ensure that, when grafts are enabled, 'transaction-upgrade-entry' doesn't
|
|
|
|
|
|
;; try to build stuff.
|
|
|
|
|
|
(with-build-handler (const 'failed!)
|
|
|
|
|
|
(parameterize ((%graft? #t))
|
|
|
|
|
|
(let* ((old (dummy-package "foo" (version "1")))
|
|
|
|
|
|
(bar (dummy-package "bar" (version "0")
|
|
|
|
|
|
(replacement old)))
|
|
|
|
|
|
(new (dummy-package "foo" (version "1")
|
|
|
|
|
|
(inputs `(("bar" ,bar)))))
|
|
|
|
|
|
(tx (mock ((gnu packages) find-best-packages-by-name
|
|
|
|
|
|
(const (list new)))
|
|
|
|
|
|
(transaction-upgrade-entry
|
|
|
|
|
|
%store
|
|
|
|
|
|
(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)
|
|
|
|
|
|
((($ <manifest-entry> "foo" "1" "out" item))
|
|
|
|
|
|
(eq? item new)))
|
|
|
|
|
|
(null? (manifest-transaction-remove tx)))))))
|
|
|
|
|
|
|
2013-04-22 21:07:13 +00:00
|
|
|
|
(test-assert "package-field-location"
|
|
|
|
|
|
(let ()
|
|
|
|
|
|
(define (goto port line column)
|
|
|
|
|
|
(unless (and (= (port-column port) (- column 1))
|
|
|
|
|
|
(= (port-line port) (- line 1)))
|
|
|
|
|
|
(unless (eof-object? (get-char port))
|
|
|
|
|
|
(goto port line column))))
|
|
|
|
|
|
|
|
|
|
|
|
(define read-at
|
|
|
|
|
|
(match-lambda
|
|
|
|
|
|
(($ <location> file line column)
|
|
|
|
|
|
(call-with-input-file (search-path %load-path file)
|
|
|
|
|
|
(lambda (port)
|
|
|
|
|
|
(goto port line column)
|
|
|
|
|
|
(read port))))))
|
|
|
|
|
|
|
2013-07-08 20:53:31 +00:00
|
|
|
|
;; Until Guile 2.0.6 included, source properties were added only to pairs.
|
|
|
|
|
|
;; Thus, check against both VALUE and (FIELD VALUE).
|
|
|
|
|
|
(and (member (read-at (package-field-location %bootstrap-guile 'name))
|
|
|
|
|
|
(let ((name (package-name %bootstrap-guile)))
|
|
|
|
|
|
(list name `(name ,name))))
|
|
|
|
|
|
(member (read-at (package-field-location %bootstrap-guile 'version))
|
|
|
|
|
|
(let ((version (package-version %bootstrap-guile)))
|
|
|
|
|
|
(list version `(version ,version))))
|
2013-04-24 12:43:31 +00:00
|
|
|
|
(not (package-field-location %bootstrap-guile 'does-not-exist)))))
|
2013-04-22 21:07:13 +00:00
|
|
|
|
|
2013-11-18 22:56:07 +00:00
|
|
|
|
;; Make sure we don't change the file name to an absolute file name.
|
|
|
|
|
|
(test-equal "package-field-location, relative file name"
|
|
|
|
|
|
(location-file (package-location %bootstrap-guile))
|
|
|
|
|
|
(with-fluids ((%file-port-name-canonicalization 'absolute))
|
|
|
|
|
|
(location-file (package-field-location %bootstrap-guile 'version))))
|
|
|
|
|
|
|
2012-07-07 18:14:20 +00:00
|
|
|
|
(test-assert "package-transitive-inputs"
|
|
|
|
|
|
(let* ((a (dummy-package "a"))
|
|
|
|
|
|
(b (dummy-package "b"
|
|
|
|
|
|
(propagated-inputs `(("a" ,a)))))
|
|
|
|
|
|
(c (dummy-package "c"
|
|
|
|
|
|
(inputs `(("a" ,a)))))
|
|
|
|
|
|
(d (dummy-package "d"
|
|
|
|
|
|
(propagated-inputs `(("x" "something.drv")))))
|
|
|
|
|
|
(e (dummy-package "e"
|
|
|
|
|
|
(inputs `(("b" ,b) ("c" ,c) ("d" ,d))))))
|
|
|
|
|
|
(and (null? (package-transitive-inputs a))
|
|
|
|
|
|
(equal? `(("a" ,a)) (package-transitive-inputs b))
|
|
|
|
|
|
(equal? `(("a" ,a)) (package-transitive-inputs c))
|
|
|
|
|
|
(equal? (package-propagated-inputs d)
|
|
|
|
|
|
(package-transitive-inputs d))
|
packages: Rewrite 'transitive-inputs' to be linear and remove duplicates.
There were two issues:
1. Use of 'delete-duplicates', which is quadratic, was a serious problem for
closures with lots of propagated inputs, such as that of the 'hydra'
package (several minutes for 'guix build hydra -n'!).
2. The 'delete-duplicates' call essentially had no effect since duplicate
inputs typically had a different label and were thus kept. For
instance, (bag-transitive-inputs (package->bag inkscape)) would return
216 items whereas (delete-duplicates (map cdr THAT)) contains only 67
items.
The new implementation returns 67 items in this case. For 'hydra', we're
down from 42211 items to 361, and roughly 13s for 'guix build hydra'.
* guix/packages.scm (transitive-inputs): Rewrite as a breadth-first
traversal. Remove duplicate propagated inputs.
* tests/packages.scm ("package-transitive-inputs", "package->bag, propagated
inputs"): Adjust to use simple labels for propagated inputs, without "/".
("package-transitive-inputs, no duplicates"): New test.
2015-07-11 21:13:24 +00:00
|
|
|
|
(equal? `(("b" ,b) ("c" ,c) ("d" ,d)
|
|
|
|
|
|
("a" ,a) ("x" "something.drv"))
|
2012-07-07 18:14:20 +00:00
|
|
|
|
(pk 'x (package-transitive-inputs e))))))
|
|
|
|
|
|
|
packages: Rewrite 'transitive-inputs' to be linear and remove duplicates.
There were two issues:
1. Use of 'delete-duplicates', which is quadratic, was a serious problem for
closures with lots of propagated inputs, such as that of the 'hydra'
package (several minutes for 'guix build hydra -n'!).
2. The 'delete-duplicates' call essentially had no effect since duplicate
inputs typically had a different label and were thus kept. For
instance, (bag-transitive-inputs (package->bag inkscape)) would return
216 items whereas (delete-duplicates (map cdr THAT)) contains only 67
items.
The new implementation returns 67 items in this case. For 'hydra', we're
down from 42211 items to 361, and roughly 13s for 'guix build hydra'.
* guix/packages.scm (transitive-inputs): Rewrite as a breadth-first
traversal. Remove duplicate propagated inputs.
* tests/packages.scm ("package-transitive-inputs", "package->bag, propagated
inputs"): Adjust to use simple labels for propagated inputs, without "/".
("package-transitive-inputs, no duplicates"): New test.
2015-07-11 21:13:24 +00:00
|
|
|
|
(test-assert "package-transitive-inputs, no duplicates"
|
|
|
|
|
|
(let* ((a (dummy-package "a"))
|
|
|
|
|
|
(b (dummy-package "b"
|
|
|
|
|
|
(inputs `(("a+" ,a)))
|
|
|
|
|
|
(native-inputs `(("a*" ,a)))
|
|
|
|
|
|
(propagated-inputs `(("a" ,a)))))
|
|
|
|
|
|
(c (dummy-package "c"
|
|
|
|
|
|
(propagated-inputs `(("b" ,b)))))
|
|
|
|
|
|
(d (dummy-package "d"
|
|
|
|
|
|
(inputs `(("a" ,a) ("c" ,c)))))
|
|
|
|
|
|
(e (dummy-package "e"
|
|
|
|
|
|
(inputs `(("b" ,b) ("c" ,c))))))
|
|
|
|
|
|
(and (null? (package-transitive-inputs a))
|
|
|
|
|
|
(equal? `(("a*" ,a) ("a+" ,a) ("a" ,a)) ;here duplicates are kept
|
|
|
|
|
|
(package-transitive-inputs b))
|
|
|
|
|
|
(equal? `(("b" ,b) ("a" ,a))
|
|
|
|
|
|
(package-transitive-inputs c))
|
|
|
|
|
|
(equal? `(("a" ,a) ("c" ,c) ("b" ,b)) ;duplicate A removed
|
|
|
|
|
|
(package-transitive-inputs d))
|
|
|
|
|
|
(equal? `(("b" ,b) ("c" ,c) ("a" ,a))
|
|
|
|
|
|
(package-transitive-inputs e))))) ;ditto
|
|
|
|
|
|
|
2014-10-17 21:20:39 +00:00
|
|
|
|
(test-equal "package-transitive-supported-systems"
|
2014-11-03 20:26:48 +00:00
|
|
|
|
'(("x" "y" "z") ;a
|
|
|
|
|
|
("x" "y") ;b
|
|
|
|
|
|
("y") ;c
|
|
|
|
|
|
("y") ;d
|
|
|
|
|
|
("y")) ;e
|
2015-04-11 10:41:49 +00:00
|
|
|
|
;; Use TRIVIAL-BUILD-SYSTEM because it doesn't add implicit inputs and thus
|
|
|
|
|
|
;; doesn't restrict the set of supported systems.
|
|
|
|
|
|
(let* ((a (dummy-package "a"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(supported-systems '("x" "y" "z"))))
|
|
|
|
|
|
(b (dummy-package "b"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(supported-systems '("x" "y"))
|
|
|
|
|
|
(inputs `(("a" ,a)))))
|
|
|
|
|
|
(c (dummy-package "c"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(supported-systems '("y" "z"))
|
|
|
|
|
|
(inputs `(("b" ,b)))))
|
|
|
|
|
|
(d (dummy-package "d"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(supported-systems '("x" "y" "z"))
|
|
|
|
|
|
(inputs `(("b" ,b) ("c" ,c)))))
|
|
|
|
|
|
(e (dummy-package "e"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(supported-systems '("x" "y" "z"))
|
|
|
|
|
|
(inputs `(("d" ,d))))))
|
2014-10-17 21:20:39 +00:00
|
|
|
|
(list (package-transitive-supported-systems a)
|
|
|
|
|
|
(package-transitive-supported-systems b)
|
2014-11-03 20:26:48 +00:00
|
|
|
|
(package-transitive-supported-systems c)
|
|
|
|
|
|
(package-transitive-supported-systems d)
|
|
|
|
|
|
(package-transitive-supported-systems e))))
|
2014-10-17 21:20:39 +00:00
|
|
|
|
|
2019-01-25 09:05:31 +00:00
|
|
|
|
(test-assert "package-closure"
|
|
|
|
|
|
(let-syntax ((dummy-package/no-implicit
|
|
|
|
|
|
(syntax-rules ()
|
|
|
|
|
|
((_ name rest ...)
|
|
|
|
|
|
(package
|
|
|
|
|
|
(inherit (dummy-package name rest ...))
|
|
|
|
|
|
(build-system trivial-build-system))))))
|
|
|
|
|
|
(let* ((a (dummy-package/no-implicit "a"))
|
|
|
|
|
|
(b (dummy-package/no-implicit "b"
|
|
|
|
|
|
(propagated-inputs `(("a" ,a)))))
|
|
|
|
|
|
(c (dummy-package/no-implicit "c"
|
|
|
|
|
|
(inputs `(("a" ,a)))))
|
|
|
|
|
|
(d (dummy-package/no-implicit "d"
|
|
|
|
|
|
(native-inputs `(("b" ,b)))))
|
|
|
|
|
|
(e (dummy-package/no-implicit "e"
|
|
|
|
|
|
(inputs `(("c" ,c) ("d" ,d))))))
|
|
|
|
|
|
(lset= eq?
|
|
|
|
|
|
(list a b c d e)
|
|
|
|
|
|
(package-closure (list e))
|
|
|
|
|
|
(package-closure (list e d))
|
|
|
|
|
|
(package-closure (list e c b))))))
|
|
|
|
|
|
|
2015-09-10 20:39:44 +00:00
|
|
|
|
(test-equal "origin-actual-file-name"
|
|
|
|
|
|
"foo-1.tar.gz"
|
|
|
|
|
|
(let ((o (dummy-origin (uri "http://www.example.com/foo-1.tar.gz"))))
|
|
|
|
|
|
(origin-actual-file-name o)))
|
|
|
|
|
|
|
|
|
|
|
|
(test-equal "origin-actual-file-name, file-name"
|
|
|
|
|
|
"foo-1.tar.gz"
|
|
|
|
|
|
(let ((o (dummy-origin
|
|
|
|
|
|
(uri "http://www.example.com/tarball")
|
|
|
|
|
|
(file-name "foo-1.tar.gz"))))
|
|
|
|
|
|
(origin-actual-file-name o)))
|
|
|
|
|
|
|
2015-04-24 12:57:51 +00:00
|
|
|
|
(let* ((o (dummy-origin))
|
|
|
|
|
|
(u (dummy-origin))
|
|
|
|
|
|
(i (dummy-origin))
|
|
|
|
|
|
(a (dummy-package "a"))
|
|
|
|
|
|
(b (dummy-package "b"
|
|
|
|
|
|
(inputs `(("a" ,a) ("i" ,i)))))
|
|
|
|
|
|
(c (package (inherit b) (source o)))
|
|
|
|
|
|
(d (dummy-package "d"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(source u) (inputs `(("c" ,c))))))
|
|
|
|
|
|
(test-assert "package-direct-sources, no source"
|
|
|
|
|
|
(null? (package-direct-sources a)))
|
|
|
|
|
|
(test-equal "package-direct-sources, #f source"
|
|
|
|
|
|
(list i)
|
|
|
|
|
|
(package-direct-sources b))
|
|
|
|
|
|
(test-equal "package-direct-sources, not input source"
|
|
|
|
|
|
(list u)
|
|
|
|
|
|
(package-direct-sources d))
|
|
|
|
|
|
(test-assert "package-direct-sources"
|
|
|
|
|
|
(let ((s (package-direct-sources c)))
|
|
|
|
|
|
(and (= (length (pk 's-sources s)) 2)
|
|
|
|
|
|
(member o s)
|
|
|
|
|
|
(member i s))))
|
|
|
|
|
|
(test-assert "package-transitive-sources"
|
|
|
|
|
|
(let ((s (package-transitive-sources d)))
|
|
|
|
|
|
(and (= (length (pk 'd-sources s)) 3)
|
|
|
|
|
|
(member o s)
|
|
|
|
|
|
(member i s)
|
|
|
|
|
|
(member u s)))))
|
|
|
|
|
|
|
2015-07-22 01:45:54 +00:00
|
|
|
|
(test-assert "transitive-input-references"
|
|
|
|
|
|
(let* ((a (dummy-package "a"))
|
|
|
|
|
|
(b (dummy-package "b"))
|
|
|
|
|
|
(c (dummy-package "c"
|
|
|
|
|
|
(inputs `(("a" ,a)))
|
|
|
|
|
|
(propagated-inputs `(("boo" ,b)))))
|
|
|
|
|
|
(d (dummy-package "d"
|
|
|
|
|
|
(inputs `(("c*" ,c)))))
|
|
|
|
|
|
(keys (map (match-lambda
|
|
|
|
|
|
(('assoc-ref 'l key)
|
|
|
|
|
|
key))
|
|
|
|
|
|
(pk 'refs (transitive-input-references
|
|
|
|
|
|
'l (package-inputs d))))))
|
|
|
|
|
|
(and (= (length keys) 2)
|
|
|
|
|
|
(member "c*" keys)
|
|
|
|
|
|
(member "boo" keys))))
|
|
|
|
|
|
|
2015-04-11 10:41:49 +00:00
|
|
|
|
(test-equal "package-transitive-supported-systems, implicit inputs"
|
|
|
|
|
|
%supported-systems
|
|
|
|
|
|
|
2018-09-23 06:04:19 +00:00
|
|
|
|
;; Here GNU-BUILD-SYSTEM adds implicit inputs that build only on
|
|
|
|
|
|
;; %SUPPORTED-SYSTEMS. Thus the others must be ignored.
|
|
|
|
|
|
(let ((p (dummy-package "foo"
|
|
|
|
|
|
(build-system gnu-build-system)
|
|
|
|
|
|
(supported-systems
|
|
|
|
|
|
`("does-not-exist" "foobar" ,@%supported-systems)))))
|
|
|
|
|
|
(parameterize ((%current-system "armhf-linux")) ; a traditionally-bootstrapped architecture
|
|
|
|
|
|
(package-transitive-supported-systems p))))
|
|
|
|
|
|
|
|
|
|
|
|
(test-equal "package-transitive-supported-systems: reduced binary seed, implicit inputs"
|
|
|
|
|
|
'("x86_64-linux" "i686-linux")
|
|
|
|
|
|
|
2015-04-11 10:41:49 +00:00
|
|
|
|
;; Here GNU-BUILD-SYSTEM adds implicit inputs that build only on
|
|
|
|
|
|
;; %SUPPORTED-SYSTEMS. Thus the others must be ignored.
|
|
|
|
|
|
(let ((p (dummy-package "foo"
|
|
|
|
|
|
(build-system gnu-build-system)
|
|
|
|
|
|
(supported-systems
|
|
|
|
|
|
`("does-not-exist" "foobar" ,@%supported-systems)))))
|
2018-09-23 06:04:19 +00:00
|
|
|
|
(parameterize ((%current-system "x86_64-linux"))
|
|
|
|
|
|
(package-transitive-supported-systems p))))
|
2015-04-11 10:41:49 +00:00
|
|
|
|
|
2015-04-19 14:49:09 +00:00
|
|
|
|
(test-assert "supported-package?"
|
2019-09-06 12:41:58 +00:00
|
|
|
|
(let* ((d (dummy-package "dep"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(supported-systems '("x86_64-linux"))))
|
|
|
|
|
|
(p (dummy-package "foo"
|
|
|
|
|
|
(build-system gnu-build-system)
|
|
|
|
|
|
(inputs `(("d" ,d)))
|
|
|
|
|
|
(supported-systems '("x86_64-linux" "armhf-linux")))))
|
|
|
|
|
|
(and (supported-package? p "x86_64-linux")
|
|
|
|
|
|
(not (supported-package? p "i686-linux"))
|
|
|
|
|
|
(not (supported-package? p "armhf-linux")))))
|
|
|
|
|
|
|
|
|
|
|
|
(test-assert "supported-package? vs. system-dependent graph"
|
|
|
|
|
|
;; The inputs of a package can depend on (%current-system). Thus,
|
|
|
|
|
|
;; 'supported-package?' must make sure that it binds (%current-system)
|
|
|
|
|
|
;; appropriately before traversing the dependency graph. In the example
|
|
|
|
|
|
;; below, 'supported-package?' must thus return true for both systems.
|
|
|
|
|
|
(let* ((p0a (dummy-package "foo-arm"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(supported-systems '("armhf-linux"))))
|
|
|
|
|
|
(p0b (dummy-package "foo-x86_64"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(supported-systems '("x86_64-linux"))))
|
|
|
|
|
|
(p (dummy-package "bar"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(inputs
|
|
|
|
|
|
(if (string=? (%current-system) "armhf-linux")
|
|
|
|
|
|
`(("foo" ,p0a))
|
|
|
|
|
|
`(("foo" ,p0b)))))))
|
2015-04-19 14:49:09 +00:00
|
|
|
|
(and (supported-package? p "x86_64-linux")
|
2019-09-06 12:41:58 +00:00
|
|
|
|
(supported-package? p "armhf-linux"))))
|
2015-04-19 14:49:09 +00:00
|
|
|
|
|
2013-08-24 14:58:44 +00:00
|
|
|
|
(test-skip (if (not %store) 8 0))
|
|
|
|
|
|
|
|
|
|
|
|
(test-assert "package-source-derivation, file"
|
|
|
|
|
|
(let* ((file (search-path %load-path "guix.scm"))
|
|
|
|
|
|
(package (package (inherit (dummy-package "p"))
|
|
|
|
|
|
(source file)))
|
|
|
|
|
|
(source (package-source-derivation %store
|
|
|
|
|
|
(package-source package))))
|
|
|
|
|
|
(and (store-path? source)
|
|
|
|
|
|
(valid-path? %store source)
|
|
|
|
|
|
(equal? (call-with-input-file source get-bytevector-all)
|
|
|
|
|
|
(call-with-input-file file get-bytevector-all)))))
|
|
|
|
|
|
|
|
|
|
|
|
(test-assert "package-source-derivation, store path"
|
|
|
|
|
|
(let* ((file (add-to-store %store "guix.scm" #t "sha256"
|
|
|
|
|
|
(search-path %load-path "guix.scm")))
|
|
|
|
|
|
(package (package (inherit (dummy-package "p"))
|
|
|
|
|
|
(source file)))
|
|
|
|
|
|
(source (package-source-derivation %store
|
|
|
|
|
|
(package-source package))))
|
|
|
|
|
|
(string=? file source)))
|
2013-01-20 21:17:58 +00:00
|
|
|
|
|
2013-11-12 22:44:47 +00:00
|
|
|
|
(test-assert "package-source-derivation, indirect store path"
|
|
|
|
|
|
(let* ((dir (add-to-store %store "guix-build" #t "sha256"
|
|
|
|
|
|
(dirname (search-path %load-path
|
|
|
|
|
|
"guix/build/utils.scm"))))
|
|
|
|
|
|
(package (package (inherit (dummy-package "p"))
|
|
|
|
|
|
(source (string-append dir "/utils.scm"))))
|
|
|
|
|
|
(source (package-source-derivation %store
|
|
|
|
|
|
(package-source package))))
|
|
|
|
|
|
(and (direct-store-path? source)
|
|
|
|
|
|
(string-suffix? "utils.scm" source))))
|
|
|
|
|
|
|
2016-06-15 08:38:46 +00:00
|
|
|
|
(test-assert "package-source-derivation, local-file"
|
|
|
|
|
|
(let* ((file (local-file "../guix/base32.scm"))
|
|
|
|
|
|
(package (package (inherit (dummy-package "p"))
|
|
|
|
|
|
(source file)))
|
|
|
|
|
|
(source (package-source-derivation %store
|
|
|
|
|
|
(package-source package))))
|
|
|
|
|
|
(and (store-path? source)
|
|
|
|
|
|
(string-suffix? "base32.scm" source)
|
|
|
|
|
|
(valid-path? %store source)
|
|
|
|
|
|
(equal? (call-with-input-file source get-bytevector-all)
|
|
|
|
|
|
(call-with-input-file
|
|
|
|
|
|
(search-path %load-path "guix/base32.scm")
|
|
|
|
|
|
get-bytevector-all)))))
|
|
|
|
|
|
|
2020-05-19 13:55:08 +00:00
|
|
|
|
(test-equal "package-source-derivation, origin, sha512"
|
|
|
|
|
|
"hello"
|
|
|
|
|
|
(let* ((bash (search-bootstrap-binary "bash" (%current-system)))
|
|
|
|
|
|
(builder (add-text-to-store %store "my-fixed-builder.sh"
|
|
|
|
|
|
"echo -n hello > $out" '()))
|
|
|
|
|
|
(method (lambda* (url hash-algo hash #:optional name
|
|
|
|
|
|
#:rest rest)
|
|
|
|
|
|
(and (eq? hash-algo 'sha512)
|
|
|
|
|
|
(raw-derivation name bash (list builder)
|
|
|
|
|
|
#:sources (list builder)
|
|
|
|
|
|
#:hash hash
|
|
|
|
|
|
#:hash-algo hash-algo))))
|
|
|
|
|
|
(source (origin
|
|
|
|
|
|
(method method)
|
|
|
|
|
|
(uri "unused://")
|
|
|
|
|
|
(file-name "origin-sha512")
|
|
|
|
|
|
(hash (content-hash
|
2020-05-23 13:45:22 +00:00
|
|
|
|
(gcrypt:bytevector-hash (string->utf8 "hello")
|
|
|
|
|
|
(gcrypt:lookup-hash-algorithm
|
|
|
|
|
|
'sha512))
|
2020-05-19 13:55:08 +00:00
|
|
|
|
sha512))))
|
|
|
|
|
|
(drv (package-source-derivation %store source))
|
|
|
|
|
|
(output (derivation->output-path drv)))
|
|
|
|
|
|
(build-derivations %store (list drv))
|
|
|
|
|
|
(call-with-input-file output get-string-all)))
|
|
|
|
|
|
|
2020-06-23 14:35:58 +00:00
|
|
|
|
(test-equal "package-source-derivation, origin, sha3-512"
|
|
|
|
|
|
"hello, sha3"
|
|
|
|
|
|
(let* ((bash (search-bootstrap-binary "bash" (%current-system)))
|
|
|
|
|
|
(builder (add-text-to-store %store "my-fixed-builder.sh"
|
|
|
|
|
|
"echo -n hello, sha3 > $out" '()))
|
|
|
|
|
|
(method (lambda* (url hash-algo hash #:optional name
|
|
|
|
|
|
#:rest rest)
|
|
|
|
|
|
(and (eq? hash-algo 'sha3-512)
|
|
|
|
|
|
(raw-derivation name bash (list builder)
|
|
|
|
|
|
#:sources (list builder)
|
|
|
|
|
|
#:hash hash
|
|
|
|
|
|
#:hash-algo hash-algo))))
|
|
|
|
|
|
(source (origin
|
|
|
|
|
|
(method method)
|
|
|
|
|
|
(uri "unused://")
|
|
|
|
|
|
(file-name "origin-sha3")
|
|
|
|
|
|
(hash (content-hash
|
|
|
|
|
|
(gcrypt:bytevector-hash (string->utf8 "hello, sha3")
|
|
|
|
|
|
(gcrypt:lookup-hash-algorithm
|
|
|
|
|
|
'sha3-512))
|
|
|
|
|
|
sha3-512))))
|
|
|
|
|
|
(drv (package-source-derivation %store source))
|
|
|
|
|
|
(output (derivation->output-path drv)))
|
|
|
|
|
|
(build-derivations %store (list drv))
|
|
|
|
|
|
(call-with-input-file output get-string-all)))
|
|
|
|
|
|
|
2015-02-23 22:41:26 +00:00
|
|
|
|
(unless (network-reachable?) (test-skip 1))
|
2013-11-07 21:41:21 +00:00
|
|
|
|
(test-equal "package-source-derivation, snippet"
|
|
|
|
|
|
"OK"
|
2018-03-15 09:25:10 +00:00
|
|
|
|
(let* ((source (bootstrap-origin
|
2013-11-07 21:41:21 +00:00
|
|
|
|
(origin
|
2018-03-15 09:25:10 +00:00
|
|
|
|
(inherit (bootstrap-guile-origin (%current-system)))
|
2013-11-07 21:41:21 +00:00
|
|
|
|
(patch-inputs
|
|
|
|
|
|
`(("tar" ,%bootstrap-coreutils&co)
|
|
|
|
|
|
("xz" ,%bootstrap-coreutils&co)
|
|
|
|
|
|
("patch" ,%bootstrap-coreutils&co)))
|
2013-11-08 20:58:09 +00:00
|
|
|
|
(patch-guile %bootstrap-guile)
|
2013-11-07 21:41:21 +00:00
|
|
|
|
(modules '((guix build utils)))
|
|
|
|
|
|
(snippet '(begin
|
|
|
|
|
|
;; We end up in 'bin', because it's the first
|
|
|
|
|
|
;; directory, alphabetically. Not a very good
|
|
|
|
|
|
;; example but hey.
|
|
|
|
|
|
(chmod "." #o777)
|
|
|
|
|
|
(symlink "guile" "guile-rocks")
|
|
|
|
|
|
(copy-recursively "../share/guile/2.0/scripts"
|
2015-09-24 08:36:24 +00:00
|
|
|
|
"scripts")
|
|
|
|
|
|
|
|
|
|
|
|
;; Make sure '.file_list' can be created.
|
|
|
|
|
|
(chmod ".." #o777))))))
|
2013-11-07 21:41:21 +00:00
|
|
|
|
(package (package (inherit (dummy-package "with-snippet"))
|
|
|
|
|
|
(source source)
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(inputs
|
|
|
|
|
|
`(("tar" ,(search-bootstrap-binary "tar"
|
|
|
|
|
|
(%current-system)))
|
|
|
|
|
|
("xz" ,(search-bootstrap-binary "xz"
|
|
|
|
|
|
(%current-system)))))
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
2018-03-28 00:05:58 +00:00
|
|
|
|
#:modules ((guix build utils))
|
2013-11-07 21:41:21 +00:00
|
|
|
|
#:builder
|
2018-03-28 00:05:58 +00:00
|
|
|
|
(begin
|
|
|
|
|
|
(use-modules (guix build utils))
|
|
|
|
|
|
(let ((tar (assoc-ref %build-inputs "tar"))
|
|
|
|
|
|
(xz (assoc-ref %build-inputs "xz"))
|
|
|
|
|
|
(source (assoc-ref %build-inputs "source")))
|
|
|
|
|
|
(invoke tar "xvf" source
|
|
|
|
|
|
"--use-compress-program" xz)
|
|
|
|
|
|
(unless (and (string=? "guile" (readlink "bin/guile-rocks"))
|
|
|
|
|
|
(file-exists? "bin/scripts/compile.scm"))
|
|
|
|
|
|
(error "the snippet apparently failed"))
|
|
|
|
|
|
(let ((out (assoc-ref %outputs "out")))
|
|
|
|
|
|
(call-with-output-file out
|
|
|
|
|
|
(lambda (p)
|
|
|
|
|
|
(display "OK" p))))
|
|
|
|
|
|
#t))))))
|
2013-11-07 21:41:21 +00:00
|
|
|
|
(drv (package-derivation %store package))
|
|
|
|
|
|
(out (derivation->output-path drv)))
|
|
|
|
|
|
(and (build-derivations %store (list (pk 'snippet-drv drv)))
|
|
|
|
|
|
(call-with-input-file out get-string-all))))
|
|
|
|
|
|
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 15:01:40 +00:00
|
|
|
|
(test-assert "return value"
|
|
|
|
|
|
(let ((drv (package-derivation %store (dummy-package "p"))))
|
|
|
|
|
|
(and (derivation? drv)
|
|
|
|
|
|
(file-exists? (derivation-file-name drv)))))
|
2012-09-10 20:47:10 +00:00
|
|
|
|
|
2013-02-16 00:37:26 +00:00
|
|
|
|
(test-assert "package-output"
|
|
|
|
|
|
(let* ((package (dummy-package "p"))
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 15:01:40 +00:00
|
|
|
|
(drv (package-derivation %store package)))
|
|
|
|
|
|
(and (derivation? drv)
|
|
|
|
|
|
(string=? (derivation->output-path drv)
|
2013-02-16 00:37:26 +00:00
|
|
|
|
(package-output %store package "out")))))
|
|
|
|
|
|
|
2020-07-25 16:26:18 +00:00
|
|
|
|
(test-equal "patch not found yields a run-time error"
|
|
|
|
|
|
'("~a: patch not found\n" "does-not-exist.patch")
|
|
|
|
|
|
(guard (c ((formatted-message? c)
|
|
|
|
|
|
(cons (formatted-message-string c)
|
|
|
|
|
|
(formatted-message-arguments c))))
|
2015-01-20 09:17:24 +00:00
|
|
|
|
(let ((p (package
|
|
|
|
|
|
(inherit (dummy-package "p"))
|
|
|
|
|
|
(source (origin
|
|
|
|
|
|
(method (const #f))
|
|
|
|
|
|
(uri "http://whatever")
|
|
|
|
|
|
(patches
|
|
|
|
|
|
(list (search-patch "does-not-exist.patch")))
|
|
|
|
|
|
(sha256
|
|
|
|
|
|
(base32
|
|
|
|
|
|
"0amn0bbwqvsvvsh6drfwz20ydc2czk374lzw5kksbh6bf78k4ks4")))))))
|
|
|
|
|
|
(package-derivation %store p)
|
|
|
|
|
|
#f)))
|
|
|
|
|
|
|
2017-04-03 22:00:41 +00:00
|
|
|
|
(let ((dummy (dummy-package "foo" (inputs `(("x" ,(current-module)))))))
|
|
|
|
|
|
(test-equal "&package-input-error"
|
|
|
|
|
|
(list dummy (current-module))
|
|
|
|
|
|
(guard (c ((package-input-error? c)
|
|
|
|
|
|
(list (package-error-package c)
|
|
|
|
|
|
(package-error-invalid-input c))))
|
|
|
|
|
|
(package-derivation %store dummy))))
|
|
|
|
|
|
|
2015-01-24 21:50:40 +00:00
|
|
|
|
(test-assert "reference to non-existent output"
|
|
|
|
|
|
;; See <http://bugs.gnu.org/19630>.
|
2015-02-06 17:04:19 +00:00
|
|
|
|
(parameterize ((%graft? #f))
|
|
|
|
|
|
(let* ((dep (dummy-package "dep"))
|
|
|
|
|
|
(p (dummy-package "p"
|
|
|
|
|
|
(inputs `(("dep" ,dep "non-existent"))))))
|
|
|
|
|
|
(guard (c ((derivation-missing-output-error? c)
|
|
|
|
|
|
(and (string=? (derivation-missing-output c) "non-existent")
|
|
|
|
|
|
(equal? (package-derivation %store dep)
|
|
|
|
|
|
(derivation-error-derivation c)))))
|
|
|
|
|
|
(package-derivation %store p)))))
|
2015-01-24 21:50:40 +00:00
|
|
|
|
|
2012-09-10 20:47:10 +00:00
|
|
|
|
(test-assert "trivial"
|
|
|
|
|
|
(let* ((p (package (inherit (dummy-package "trivial"))
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(source #f)
|
|
|
|
|
|
(arguments
|
2012-10-05 23:24:46 +00:00
|
|
|
|
`(#:guile ,%bootstrap-guile
|
|
|
|
|
|
#:builder
|
2012-09-10 20:47:10 +00:00
|
|
|
|
(begin
|
|
|
|
|
|
(mkdir %output)
|
|
|
|
|
|
(call-with-output-file (string-append %output "/test")
|
|
|
|
|
|
(lambda (p)
|
2018-03-28 00:05:58 +00:00
|
|
|
|
(display '(hello guix) p)))
|
|
|
|
|
|
#t)))))
|
2012-09-10 20:47:10 +00:00
|
|
|
|
(d (package-derivation %store p)))
|
|
|
|
|
|
(and (build-derivations %store (list d))
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 15:01:40 +00:00
|
|
|
|
(let ((p (pk 'drv d (derivation->output-path d))))
|
2012-09-10 20:47:10 +00:00
|
|
|
|
(equal? '(hello guix)
|
|
|
|
|
|
(call-with-input-file (string-append p "/test") read))))))
|
2012-06-27 23:24:34 +00:00
|
|
|
|
|
2012-12-04 22:46:50 +00:00
|
|
|
|
(test-assert "trivial with local file as input"
|
|
|
|
|
|
(let* ((i (search-path %load-path "ice-9/boot-9.scm"))
|
|
|
|
|
|
(p (package (inherit (dummy-package "trivial-with-input-file"))
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(source #f)
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
2018-03-28 00:05:58 +00:00
|
|
|
|
#:builder (begin
|
|
|
|
|
|
(copy-file (assoc-ref %build-inputs "input")
|
|
|
|
|
|
%output)
|
|
|
|
|
|
#t)))
|
2012-12-04 22:46:50 +00:00
|
|
|
|
(inputs `(("input" ,i)))))
|
|
|
|
|
|
(d (package-derivation %store p)))
|
|
|
|
|
|
(and (build-derivations %store (list d))
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 15:01:40 +00:00
|
|
|
|
(let ((p (pk 'drv d (derivation->output-path d))))
|
2012-12-04 22:46:50 +00:00
|
|
|
|
(equal? (call-with-input-file p get-bytevector-all)
|
|
|
|
|
|
(call-with-input-file i get-bytevector-all))))))
|
|
|
|
|
|
|
2013-09-26 19:50:05 +00:00
|
|
|
|
(test-assert "trivial with source"
|
|
|
|
|
|
(let* ((i (search-path %load-path "ice-9/boot-9.scm"))
|
|
|
|
|
|
(p (package (inherit (dummy-package "trivial-with-source"))
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(source i)
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
2018-03-28 00:05:58 +00:00
|
|
|
|
#:builder (begin
|
|
|
|
|
|
(copy-file (assoc-ref %build-inputs "source")
|
|
|
|
|
|
%output)
|
|
|
|
|
|
#t)))))
|
2013-09-26 19:50:05 +00:00
|
|
|
|
(d (package-derivation %store p)))
|
|
|
|
|
|
(and (build-derivations %store (list d))
|
|
|
|
|
|
(let ((p (derivation->output-path d)))
|
|
|
|
|
|
(equal? (call-with-input-file p get-bytevector-all)
|
|
|
|
|
|
(call-with-input-file i get-bytevector-all))))))
|
|
|
|
|
|
|
2012-10-21 14:57:50 +00:00
|
|
|
|
(test-assert "trivial with system-dependent input"
|
|
|
|
|
|
(let* ((p (package (inherit (dummy-package "trivial-system-dependent-input"))
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(source #f)
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
2018-03-28 00:05:58 +00:00
|
|
|
|
#:modules ((guix build utils))
|
2012-10-21 14:57:50 +00:00
|
|
|
|
#:builder
|
2018-03-28 00:05:58 +00:00
|
|
|
|
(begin
|
|
|
|
|
|
(use-modules (guix build utils))
|
|
|
|
|
|
(let ((out (assoc-ref %outputs "out"))
|
|
|
|
|
|
(bash (assoc-ref %build-inputs "bash")))
|
|
|
|
|
|
(invoke bash "-c"
|
|
|
|
|
|
(format #f "echo hello > ~a" out))))))
|
2013-01-24 22:33:30 +00:00
|
|
|
|
(inputs `(("bash" ,(search-bootstrap-binary "bash"
|
|
|
|
|
|
(%current-system)))))))
|
2012-10-21 14:57:50 +00:00
|
|
|
|
(d (package-derivation %store p)))
|
|
|
|
|
|
(and (build-derivations %store (list d))
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 15:01:40 +00:00
|
|
|
|
(let ((p (pk 'drv d (derivation->output-path d))))
|
2012-10-21 14:57:50 +00:00
|
|
|
|
(eq? 'hello (call-with-input-file p read))))))
|
|
|
|
|
|
|
2018-02-28 15:42:34 +00:00
|
|
|
|
(test-assert "trivial with #:allowed-references"
|
|
|
|
|
|
(let* ((p (package
|
|
|
|
|
|
(inherit (dummy-package "trivial"))
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
|
|
|
|
|
#:allowed-references (,%bootstrap-guile)
|
|
|
|
|
|
#:builder
|
|
|
|
|
|
(begin
|
|
|
|
|
|
(mkdir %output)
|
|
|
|
|
|
;; The reference to itself isn't allowed so building it
|
|
|
|
|
|
;; should fail.
|
2018-03-28 00:05:58 +00:00
|
|
|
|
(symlink %output (string-append %output "/self"))
|
|
|
|
|
|
#t)))))
|
2018-02-28 15:42:34 +00:00
|
|
|
|
(d (package-derivation %store p)))
|
store: Rename '&nix-error' to '&store-error'.
* guix/store.scm (&nix-error): Rename to...
(&store-error): ... this, and adjust users.
(&nix-connection-error): Rename to...
(&store-connection-error): ... this, and adjust users.
(&nix-protocol-error): Rename to...
(&store-protocol-error): ... this, adjust users.
(&nix-error, &nix-connection-error, &nix-protocol-error): Define these
condition types and their getters as deprecrated aliases.
* build-aux/run-system-tests.scm, guix/derivations.scm,
guix/grafts.scm, guix/scripts/challenge.scm,
guix/scripts/graph.scm, guix/scripts/lint.scm,
guix/scripts/offload.scm, guix/serialization.scm,
guix/ssh.scm, guix/tests.scm, guix/ui.scm,
tests/derivations.scm, tests/gexp.scm, tests/guix-daemon.sh,
tests/packages.scm, tests/store.scm, doc/guix.texi: Adjust to use the
new names.
2019-01-21 16:41:11 +00:00
|
|
|
|
(guard (c ((store-protocol-error? c) #t))
|
2018-02-28 15:42:34 +00:00
|
|
|
|
(build-derivations %store (list d))
|
|
|
|
|
|
#f)))
|
|
|
|
|
|
|
2013-03-30 21:56:38 +00:00
|
|
|
|
(test-assert "search paths"
|
|
|
|
|
|
(let* ((p (make-prompt-tag "return-search-paths"))
|
|
|
|
|
|
(s (build-system
|
build-system: Introduce "bags" as an intermediate representation.
* guix/build-system.scm (<build-system>)[build, cross-build]: Remove.
[lower]: New field.
(<bag>): New record type.
(make-bag): New procedure.
* guix/packages.scm (bag-transitive-inputs, bag-transitive-build-inputs,
bag-transitive-host-inputs, bag-transitive-target-inputs,
package->bag): New procedures.
(package-derivation): Use it; use the bag, apply its build procedure,
etc.
(package-cross-derivation): Likewise.
* gnu/packages/bootstrap.scm (raw-build, make-raw-bag): New procedure.
(%bootstrap-guile): Use them.
* guix/build-system/trivial.scm (lower): New procedure.
(trivial-build, trivial-cross-build): Remove 'source' parameter. Pass
INPUTS as is.
(trivial-build-system): Adjust accordingly.
* guix/build-system/gnu.scm (%store, inputs-search-paths,
standard-search-paths, expand-inputs, standard-inputs): Remove.
(gnu-lower): New procedure.
(gnu-build): Remove 'source' and #:implicit-inputs? parameters.
Remove 'implicit-inputs' and 'implicit-search-paths' variables. Get
the source from INPUT-DRVS.
(gnu-cross-build): Likewise.
(standard-cross-packages): Remove call to 'standard-packages'.
(standard-cross-inputs, standard-cross-search-paths): Remove.
(gnu-build-system): Remove 'build' and 'cross-build'; add 'lower'.
* guix/build-system/cmake.scm (lower): New procedure.
(cmake-build): Remove 'source' and #:cmake parameters. Use INPUTS and
SEARCH-PATHS as is. Get the source from INPUTS.
* guix/build-system/perl.scm: Likewise.
* guix/build-system/python.scm: Likewise.
* guix/build-system/ruby.scm: Likewise.
* gnu/packages/cross-base.scm (cross-gcc): Change "cross-linux-headers"
to "linux-headers".
(cross-libc)[xlinux-headers]: Pass #:implicit-cross-inputs? #f.
Likewise. In 'propagated-inputs', change "cross-linux-headers" to
"linux-headers".
* guix/git-download.scm (git-fetch): Use 'standard-packages' instead of
'standard-inputs'.
* tests/builders.scm ("gnu-build-system"): Remove use of
'build-system-builder'.
("gnu-build"): Remove 'source' and #:implicit-inputs? arguments to
'gnu-build'.
* tests/packages.scm ("search paths"): Adjust to new build system API.
("package-cross-derivation, no cross builder"): Likewise.
* doc/guix.texi (Build Systems): Add paragraph on bags.
2014-10-03 16:06:16 +00:00
|
|
|
|
(name 'raw)
|
2013-03-30 21:56:38 +00:00
|
|
|
|
(description "Raw build system with direct store access")
|
2014-10-05 14:32:25 +00:00
|
|
|
|
(lower (lambda* (name #:key source inputs system target
|
|
|
|
|
|
#:allow-other-keys)
|
build-system: Introduce "bags" as an intermediate representation.
* guix/build-system.scm (<build-system>)[build, cross-build]: Remove.
[lower]: New field.
(<bag>): New record type.
(make-bag): New procedure.
* guix/packages.scm (bag-transitive-inputs, bag-transitive-build-inputs,
bag-transitive-host-inputs, bag-transitive-target-inputs,
package->bag): New procedures.
(package-derivation): Use it; use the bag, apply its build procedure,
etc.
(package-cross-derivation): Likewise.
* gnu/packages/bootstrap.scm (raw-build, make-raw-bag): New procedure.
(%bootstrap-guile): Use them.
* guix/build-system/trivial.scm (lower): New procedure.
(trivial-build, trivial-cross-build): Remove 'source' parameter. Pass
INPUTS as is.
(trivial-build-system): Adjust accordingly.
* guix/build-system/gnu.scm (%store, inputs-search-paths,
standard-search-paths, expand-inputs, standard-inputs): Remove.
(gnu-lower): New procedure.
(gnu-build): Remove 'source' and #:implicit-inputs? parameters.
Remove 'implicit-inputs' and 'implicit-search-paths' variables. Get
the source from INPUT-DRVS.
(gnu-cross-build): Likewise.
(standard-cross-packages): Remove call to 'standard-packages'.
(standard-cross-inputs, standard-cross-search-paths): Remove.
(gnu-build-system): Remove 'build' and 'cross-build'; add 'lower'.
* guix/build-system/cmake.scm (lower): New procedure.
(cmake-build): Remove 'source' and #:cmake parameters. Use INPUTS and
SEARCH-PATHS as is. Get the source from INPUTS.
* guix/build-system/perl.scm: Likewise.
* guix/build-system/python.scm: Likewise.
* guix/build-system/ruby.scm: Likewise.
* gnu/packages/cross-base.scm (cross-gcc): Change "cross-linux-headers"
to "linux-headers".
(cross-libc)[xlinux-headers]: Pass #:implicit-cross-inputs? #f.
Likewise. In 'propagated-inputs', change "cross-linux-headers" to
"linux-headers".
* guix/git-download.scm (git-fetch): Use 'standard-packages' instead of
'standard-inputs'.
* tests/builders.scm ("gnu-build-system"): Remove use of
'build-system-builder'.
("gnu-build"): Remove 'source' and #:implicit-inputs? arguments to
'gnu-build'.
* tests/packages.scm ("search paths"): Adjust to new build system API.
("package-cross-derivation, no cross builder"): Likewise.
* doc/guix.texi (Build Systems): Add paragraph on bags.
2014-10-03 16:06:16 +00:00
|
|
|
|
(bag
|
|
|
|
|
|
(name name)
|
2014-10-05 14:32:25 +00:00
|
|
|
|
(system system) (target target)
|
build-system: Introduce "bags" as an intermediate representation.
* guix/build-system.scm (<build-system>)[build, cross-build]: Remove.
[lower]: New field.
(<bag>): New record type.
(make-bag): New procedure.
* guix/packages.scm (bag-transitive-inputs, bag-transitive-build-inputs,
bag-transitive-host-inputs, bag-transitive-target-inputs,
package->bag): New procedures.
(package-derivation): Use it; use the bag, apply its build procedure,
etc.
(package-cross-derivation): Likewise.
* gnu/packages/bootstrap.scm (raw-build, make-raw-bag): New procedure.
(%bootstrap-guile): Use them.
* guix/build-system/trivial.scm (lower): New procedure.
(trivial-build, trivial-cross-build): Remove 'source' parameter. Pass
INPUTS as is.
(trivial-build-system): Adjust accordingly.
* guix/build-system/gnu.scm (%store, inputs-search-paths,
standard-search-paths, expand-inputs, standard-inputs): Remove.
(gnu-lower): New procedure.
(gnu-build): Remove 'source' and #:implicit-inputs? parameters.
Remove 'implicit-inputs' and 'implicit-search-paths' variables. Get
the source from INPUT-DRVS.
(gnu-cross-build): Likewise.
(standard-cross-packages): Remove call to 'standard-packages'.
(standard-cross-inputs, standard-cross-search-paths): Remove.
(gnu-build-system): Remove 'build' and 'cross-build'; add 'lower'.
* guix/build-system/cmake.scm (lower): New procedure.
(cmake-build): Remove 'source' and #:cmake parameters. Use INPUTS and
SEARCH-PATHS as is. Get the source from INPUTS.
* guix/build-system/perl.scm: Likewise.
* guix/build-system/python.scm: Likewise.
* guix/build-system/ruby.scm: Likewise.
* gnu/packages/cross-base.scm (cross-gcc): Change "cross-linux-headers"
to "linux-headers".
(cross-libc)[xlinux-headers]: Pass #:implicit-cross-inputs? #f.
Likewise. In 'propagated-inputs', change "cross-linux-headers" to
"linux-headers".
* guix/git-download.scm (git-fetch): Use 'standard-packages' instead of
'standard-inputs'.
* tests/builders.scm ("gnu-build-system"): Remove use of
'build-system-builder'.
("gnu-build"): Remove 'source' and #:implicit-inputs? arguments to
'gnu-build'.
* tests/packages.scm ("search paths"): Adjust to new build system API.
("package-cross-derivation, no cross builder"): Likewise.
* doc/guix.texi (Build Systems): Add paragraph on bags.
2014-10-03 16:06:16 +00:00
|
|
|
|
(build-inputs inputs)
|
|
|
|
|
|
(build
|
|
|
|
|
|
(lambda* (store name inputs
|
|
|
|
|
|
#:key outputs system search-paths)
|
|
|
|
|
|
search-paths)))))))
|
2013-03-30 21:56:38 +00:00
|
|
|
|
(x (list (search-path-specification
|
|
|
|
|
|
(variable "GUILE_LOAD_PATH")
|
packages: Add 'file-type' field to 'search-path-specification'.
Fixes <http://bugs.gnu.org/18033>.
* guix/packages.scm (<search-path-specification>): Rename 'directories'
field to 'files'. Add 'file-type'.
(search-path-specification->sexp): Honor 'file-type'.
* gnu/packages/autotools.scm, gnu/packages/bootstrap.scm,
gnu/packages/cross-base.scm, gnu/packages/games.scm,
gnu/packages/gcc.scm, gnu/packages/glib.scm,
gnu/packages/guile.scm, gnu/packages/man.scm,
gnu/packages/perl.scm, gnu/packages/pkg-config.scm,
gnu/packages/python.scm, gnu/packages/ruby.scm,
gnu/packages/xfce.scm: Change 'directories' to 'files'.
* tests/packages.scm ("search paths"): Change 'directories' field to
'files'.
* guix/scripts/environment.scm (for-each-search-path): Likewise.
2014-12-27 22:22:08 +00:00
|
|
|
|
(files '("share/guile/site/2.0")))
|
2013-03-30 21:56:38 +00:00
|
|
|
|
(search-path-specification
|
|
|
|
|
|
(variable "GUILE_LOAD_COMPILED_PATH")
|
packages: Add 'file-type' field to 'search-path-specification'.
Fixes <http://bugs.gnu.org/18033>.
* guix/packages.scm (<search-path-specification>): Rename 'directories'
field to 'files'. Add 'file-type'.
(search-path-specification->sexp): Honor 'file-type'.
* gnu/packages/autotools.scm, gnu/packages/bootstrap.scm,
gnu/packages/cross-base.scm, gnu/packages/games.scm,
gnu/packages/gcc.scm, gnu/packages/glib.scm,
gnu/packages/guile.scm, gnu/packages/man.scm,
gnu/packages/perl.scm, gnu/packages/pkg-config.scm,
gnu/packages/python.scm, gnu/packages/ruby.scm,
gnu/packages/xfce.scm: Change 'directories' to 'files'.
* tests/packages.scm ("search paths"): Change 'directories' field to
'files'.
* guix/scripts/environment.scm (for-each-search-path): Likewise.
2014-12-27 22:22:08 +00:00
|
|
|
|
(files '("share/guile/site/2.0")))))
|
2013-03-30 21:56:38 +00:00
|
|
|
|
(a (package (inherit (dummy-package "guile"))
|
|
|
|
|
|
(build-system s)
|
|
|
|
|
|
(native-search-paths x)))
|
|
|
|
|
|
(b (package (inherit (dummy-package "guile-foo"))
|
|
|
|
|
|
(build-system s)
|
|
|
|
|
|
(inputs `(("guile" ,a)))))
|
|
|
|
|
|
(c (package (inherit (dummy-package "guile-bar"))
|
|
|
|
|
|
(build-system s)
|
|
|
|
|
|
(inputs `(("guile" ,a)
|
|
|
|
|
|
("guile-foo" ,b))))))
|
|
|
|
|
|
(let-syntax ((collect (syntax-rules ()
|
|
|
|
|
|
((_ body ...)
|
|
|
|
|
|
(call-with-prompt p
|
|
|
|
|
|
(lambda ()
|
|
|
|
|
|
body ...)
|
|
|
|
|
|
(lambda (k search-paths)
|
|
|
|
|
|
search-paths))))))
|
|
|
|
|
|
(and (null? (collect (package-derivation %store a)))
|
|
|
|
|
|
(equal? x (collect (package-derivation %store b)))
|
|
|
|
|
|
(equal? x (collect (package-derivation %store c)))))))
|
|
|
|
|
|
|
2015-12-20 13:34:36 +00:00
|
|
|
|
(test-assert "package-transitive-native-search-paths"
|
|
|
|
|
|
(let* ((sp (lambda (name)
|
|
|
|
|
|
(list (search-path-specification
|
|
|
|
|
|
(variable name)
|
|
|
|
|
|
(files '("foo/bar"))))))
|
|
|
|
|
|
(p0 (dummy-package "p0" (native-search-paths (sp "PATH0"))))
|
|
|
|
|
|
(p1 (dummy-package "p1" (native-search-paths (sp "PATH1"))))
|
|
|
|
|
|
(p2 (dummy-package "p2"
|
|
|
|
|
|
(native-search-paths (sp "PATH2"))
|
|
|
|
|
|
(inputs `(("p0" ,p0)))
|
|
|
|
|
|
(propagated-inputs `(("p1" ,p1)))))
|
|
|
|
|
|
(p3 (dummy-package "p3"
|
|
|
|
|
|
(native-search-paths (sp "PATH3"))
|
|
|
|
|
|
(native-inputs `(("p0" ,p0)))
|
|
|
|
|
|
(propagated-inputs `(("p2" ,p2))))))
|
|
|
|
|
|
(lset= string=?
|
|
|
|
|
|
'("PATH1" "PATH2" "PATH3")
|
|
|
|
|
|
(map search-path-specification-variable
|
|
|
|
|
|
(package-transitive-native-search-paths p3)))))
|
|
|
|
|
|
|
2013-05-24 20:21:24 +00:00
|
|
|
|
(test-assert "package-cross-derivation"
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 15:01:40 +00:00
|
|
|
|
(let ((drv (package-cross-derivation %store (dummy-package "p")
|
|
|
|
|
|
"mips64el-linux-gnu")))
|
|
|
|
|
|
(and (derivation? drv)
|
|
|
|
|
|
(file-exists? (derivation-file-name drv)))))
|
2013-05-24 20:21:24 +00:00
|
|
|
|
|
2013-05-24 21:53:06 +00:00
|
|
|
|
(test-assert "package-cross-derivation, trivial-build-system"
|
|
|
|
|
|
(let ((p (package (inherit (dummy-package "p"))
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(arguments '(#:builder (exit 1))))))
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 15:01:40 +00:00
|
|
|
|
(let ((drv (package-cross-derivation %store p "mips64el-linux-gnu")))
|
|
|
|
|
|
(derivation? drv))))
|
2013-05-24 21:53:06 +00:00
|
|
|
|
|
2013-05-27 21:41:35 +00:00
|
|
|
|
(test-assert "package-cross-derivation, no cross builder"
|
|
|
|
|
|
(let* ((b (build-system (inherit trivial-build-system)
|
build-system: Introduce "bags" as an intermediate representation.
* guix/build-system.scm (<build-system>)[build, cross-build]: Remove.
[lower]: New field.
(<bag>): New record type.
(make-bag): New procedure.
* guix/packages.scm (bag-transitive-inputs, bag-transitive-build-inputs,
bag-transitive-host-inputs, bag-transitive-target-inputs,
package->bag): New procedures.
(package-derivation): Use it; use the bag, apply its build procedure,
etc.
(package-cross-derivation): Likewise.
* gnu/packages/bootstrap.scm (raw-build, make-raw-bag): New procedure.
(%bootstrap-guile): Use them.
* guix/build-system/trivial.scm (lower): New procedure.
(trivial-build, trivial-cross-build): Remove 'source' parameter. Pass
INPUTS as is.
(trivial-build-system): Adjust accordingly.
* guix/build-system/gnu.scm (%store, inputs-search-paths,
standard-search-paths, expand-inputs, standard-inputs): Remove.
(gnu-lower): New procedure.
(gnu-build): Remove 'source' and #:implicit-inputs? parameters.
Remove 'implicit-inputs' and 'implicit-search-paths' variables. Get
the source from INPUT-DRVS.
(gnu-cross-build): Likewise.
(standard-cross-packages): Remove call to 'standard-packages'.
(standard-cross-inputs, standard-cross-search-paths): Remove.
(gnu-build-system): Remove 'build' and 'cross-build'; add 'lower'.
* guix/build-system/cmake.scm (lower): New procedure.
(cmake-build): Remove 'source' and #:cmake parameters. Use INPUTS and
SEARCH-PATHS as is. Get the source from INPUTS.
* guix/build-system/perl.scm: Likewise.
* guix/build-system/python.scm: Likewise.
* guix/build-system/ruby.scm: Likewise.
* gnu/packages/cross-base.scm (cross-gcc): Change "cross-linux-headers"
to "linux-headers".
(cross-libc)[xlinux-headers]: Pass #:implicit-cross-inputs? #f.
Likewise. In 'propagated-inputs', change "cross-linux-headers" to
"linux-headers".
* guix/git-download.scm (git-fetch): Use 'standard-packages' instead of
'standard-inputs'.
* tests/builders.scm ("gnu-build-system"): Remove use of
'build-system-builder'.
("gnu-build"): Remove 'source' and #:implicit-inputs? arguments to
'gnu-build'.
* tests/packages.scm ("search paths"): Adjust to new build system API.
("package-cross-derivation, no cross builder"): Likewise.
* doc/guix.texi (Build Systems): Add paragraph on bags.
2014-10-03 16:06:16 +00:00
|
|
|
|
(lower (const #f))))
|
2013-05-27 21:41:35 +00:00
|
|
|
|
(p (package (inherit (dummy-package "p"))
|
|
|
|
|
|
(build-system b))))
|
|
|
|
|
|
(guard (c ((package-cross-build-system-error? c)
|
|
|
|
|
|
(eq? (package-error-package c) p)))
|
|
|
|
|
|
(package-cross-derivation %store p "mips64el-linux-gnu")
|
|
|
|
|
|
#f)))
|
|
|
|
|
|
|
2016-03-04 23:06:15 +00:00
|
|
|
|
;; XXX: The next two tests can trigger builds when the distro defines
|
|
|
|
|
|
;; replacements on core packages, so they're disable for lack of a better
|
|
|
|
|
|
;; solution.
|
|
|
|
|
|
|
|
|
|
|
|
;; (test-equal "package-derivation, direct graft"
|
|
|
|
|
|
;; (package-derivation %store gnu-make #:graft? #f)
|
|
|
|
|
|
;; (let ((p (package (inherit coreutils)
|
|
|
|
|
|
;; (replacement gnu-make))))
|
|
|
|
|
|
;; (package-derivation %store p #:graft? #t)))
|
packages: Implement grafts.
Thanks to Mark H. Weaver <mhw@netris.org> for insightful discussions
and suggestions.
* guix/packages.scm (<package>)[graft]: New field.
(patch-and-repack): Invoke 'package-derivation' with #:graft? #f.
(package-source-derivation): Likewise. Do not use (%guile-for-build)
in call to 'patch-and-repack', and we could end up using a grafted
Guile.
(expand-input): Likewise, also for 'package-cross-derivation' call.
(package->bag): Add #:graft? parameter. Honor it. Use 'strip-append'
instead of 'package-full-name'.
(input-graft, input-cross-graft, bag-grafts, package-grafts): New
procedures.
(package-derivation, package-cross-derivation): Add #:graft? parameter
and honor it.
* gnu/packages/bootstrap.scm (package-with-bootstrap-guile): Add
recursive call on 'graft'.
* guix/build-system/gnu.scm (package-with-explicit-inputs,
package-with-extra-configure-variable, static-package): Likewise.
(gnu-build): Use the ungrafted Guile to avoid full rebuilds.
(gnu-cross-build): Likewise.
* guix/build-system/cmake.scm (cmake-build): Likewise.
* guix/build-system/glib-or-gtk.scm (glib-or-gtk-build): Likewise.
* guix/build-system/perl.scm (perl-build): Likewise.
* guix/build-system/python.scm (python-build): Likewise.
* guix/build-system/ruby.scm (ruby-build): Likewise.
* guix/build-system/trivial.scm (guile-for-build): Likewise.
* tests/packages.scm ("package-derivation, direct graft",
"package-cross-derivation, direct graft", "package-grafts,
indirect grafts", "package-grafts, indirect grafts, cross",
"package-grafts, indirect grafts, propagated inputs",
"package-derivation, indirect grafts"): New tests.
("bag->derivation", "bag->derivation, cross-compilation"): Wrap in
'parameterize'.
* doc/guix.texi (Security Updates): New node.
(Invoking guix build): Document --no-graft.
2014-10-27 17:09:00 +00:00
|
|
|
|
|
2016-03-04 23:06:15 +00:00
|
|
|
|
;; (test-equal "package-cross-derivation, direct graft"
|
|
|
|
|
|
;; (package-cross-derivation %store gnu-make "mips64el-linux-gnu"
|
|
|
|
|
|
;; #:graft? #f)
|
|
|
|
|
|
;; (let ((p (package (inherit coreutils)
|
|
|
|
|
|
;; (replacement gnu-make))))
|
|
|
|
|
|
;; (package-cross-derivation %store p "mips64el-linux-gnu"
|
|
|
|
|
|
;; #:graft? #t)))
|
packages: Implement grafts.
Thanks to Mark H. Weaver <mhw@netris.org> for insightful discussions
and suggestions.
* guix/packages.scm (<package>)[graft]: New field.
(patch-and-repack): Invoke 'package-derivation' with #:graft? #f.
(package-source-derivation): Likewise. Do not use (%guile-for-build)
in call to 'patch-and-repack', and we could end up using a grafted
Guile.
(expand-input): Likewise, also for 'package-cross-derivation' call.
(package->bag): Add #:graft? parameter. Honor it. Use 'strip-append'
instead of 'package-full-name'.
(input-graft, input-cross-graft, bag-grafts, package-grafts): New
procedures.
(package-derivation, package-cross-derivation): Add #:graft? parameter
and honor it.
* gnu/packages/bootstrap.scm (package-with-bootstrap-guile): Add
recursive call on 'graft'.
* guix/build-system/gnu.scm (package-with-explicit-inputs,
package-with-extra-configure-variable, static-package): Likewise.
(gnu-build): Use the ungrafted Guile to avoid full rebuilds.
(gnu-cross-build): Likewise.
* guix/build-system/cmake.scm (cmake-build): Likewise.
* guix/build-system/glib-or-gtk.scm (glib-or-gtk-build): Likewise.
* guix/build-system/perl.scm (perl-build): Likewise.
* guix/build-system/python.scm (python-build): Likewise.
* guix/build-system/ruby.scm (ruby-build): Likewise.
* guix/build-system/trivial.scm (guile-for-build): Likewise.
* tests/packages.scm ("package-derivation, direct graft",
"package-cross-derivation, direct graft", "package-grafts,
indirect grafts", "package-grafts, indirect grafts, cross",
"package-grafts, indirect grafts, propagated inputs",
"package-derivation, indirect grafts"): New tests.
("bag->derivation", "bag->derivation, cross-compilation"): Wrap in
'parameterize'.
* doc/guix.texi (Security Updates): New node.
(Invoking guix build): Document --no-graft.
2014-10-27 17:09:00 +00:00
|
|
|
|
|
|
|
|
|
|
(test-assert "package-grafts, indirect grafts"
|
|
|
|
|
|
(let* ((new (dummy-package "dep"
|
|
|
|
|
|
(arguments '(#:implicit-inputs? #f))))
|
|
|
|
|
|
(dep (package (inherit new) (version "0.0")))
|
|
|
|
|
|
(dep* (package (inherit dep) (replacement new)))
|
|
|
|
|
|
(dummy (dummy-package "dummy"
|
|
|
|
|
|
(arguments '(#:implicit-inputs? #f))
|
|
|
|
|
|
(inputs `(("dep" ,dep*))))))
|
|
|
|
|
|
(equal? (package-grafts %store dummy)
|
|
|
|
|
|
(list (graft
|
|
|
|
|
|
(origin (package-derivation %store dep))
|
|
|
|
|
|
(replacement (package-derivation %store new)))))))
|
|
|
|
|
|
|
2016-10-14 08:36:37 +00:00
|
|
|
|
;; XXX: This test would require building the cross toolchain just to see if it
|
|
|
|
|
|
;; needs grafting, which is obviously too expensive, and thus disabled.
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; (test-assert "package-grafts, indirect grafts, cross"
|
|
|
|
|
|
;; (let* ((new (dummy-package "dep"
|
|
|
|
|
|
;; (arguments '(#:implicit-inputs? #f))))
|
|
|
|
|
|
;; (dep (package (inherit new) (version "0.0")))
|
|
|
|
|
|
;; (dep* (package (inherit dep) (replacement new)))
|
|
|
|
|
|
;; (dummy (dummy-package "dummy"
|
|
|
|
|
|
;; (arguments '(#:implicit-inputs? #f))
|
|
|
|
|
|
;; (inputs `(("dep" ,dep*)))))
|
|
|
|
|
|
;; (target "mips64el-linux-gnu"))
|
|
|
|
|
|
;; ;; XXX: There might be additional grafts, for instance if the distro
|
|
|
|
|
|
;; ;; defines replacements for core packages like Perl.
|
|
|
|
|
|
;; (member (graft
|
|
|
|
|
|
;; (origin (package-cross-derivation %store dep target))
|
|
|
|
|
|
;; (replacement
|
|
|
|
|
|
;; (package-cross-derivation %store new target)))
|
|
|
|
|
|
;; (package-grafts %store dummy #:target target))))
|
packages: Implement grafts.
Thanks to Mark H. Weaver <mhw@netris.org> for insightful discussions
and suggestions.
* guix/packages.scm (<package>)[graft]: New field.
(patch-and-repack): Invoke 'package-derivation' with #:graft? #f.
(package-source-derivation): Likewise. Do not use (%guile-for-build)
in call to 'patch-and-repack', and we could end up using a grafted
Guile.
(expand-input): Likewise, also for 'package-cross-derivation' call.
(package->bag): Add #:graft? parameter. Honor it. Use 'strip-append'
instead of 'package-full-name'.
(input-graft, input-cross-graft, bag-grafts, package-grafts): New
procedures.
(package-derivation, package-cross-derivation): Add #:graft? parameter
and honor it.
* gnu/packages/bootstrap.scm (package-with-bootstrap-guile): Add
recursive call on 'graft'.
* guix/build-system/gnu.scm (package-with-explicit-inputs,
package-with-extra-configure-variable, static-package): Likewise.
(gnu-build): Use the ungrafted Guile to avoid full rebuilds.
(gnu-cross-build): Likewise.
* guix/build-system/cmake.scm (cmake-build): Likewise.
* guix/build-system/glib-or-gtk.scm (glib-or-gtk-build): Likewise.
* guix/build-system/perl.scm (perl-build): Likewise.
* guix/build-system/python.scm (python-build): Likewise.
* guix/build-system/ruby.scm (ruby-build): Likewise.
* guix/build-system/trivial.scm (guile-for-build): Likewise.
* tests/packages.scm ("package-derivation, direct graft",
"package-cross-derivation, direct graft", "package-grafts,
indirect grafts", "package-grafts, indirect grafts, cross",
"package-grafts, indirect grafts, propagated inputs",
"package-derivation, indirect grafts"): New tests.
("bag->derivation", "bag->derivation, cross-compilation"): Wrap in
'parameterize'.
* doc/guix.texi (Security Updates): New node.
(Invoking guix build): Document --no-graft.
2014-10-27 17:09:00 +00:00
|
|
|
|
|
|
|
|
|
|
(test-assert "package-grafts, indirect grafts, propagated inputs"
|
|
|
|
|
|
(let* ((new (dummy-package "dep"
|
|
|
|
|
|
(arguments '(#:implicit-inputs? #f))))
|
|
|
|
|
|
(dep (package (inherit new) (version "0.0")))
|
|
|
|
|
|
(dep* (package (inherit dep) (replacement new)))
|
|
|
|
|
|
(prop (dummy-package "propagated"
|
|
|
|
|
|
(propagated-inputs `(("dep" ,dep*)))
|
|
|
|
|
|
(arguments '(#:implicit-inputs? #f))))
|
|
|
|
|
|
(dummy (dummy-package "dummy"
|
|
|
|
|
|
(arguments '(#:implicit-inputs? #f))
|
|
|
|
|
|
(inputs `(("prop" ,prop))))))
|
|
|
|
|
|
(equal? (package-grafts %store dummy)
|
|
|
|
|
|
(list (graft
|
|
|
|
|
|
(origin (package-derivation %store dep))
|
|
|
|
|
|
(replacement (package-derivation %store new)))))))
|
|
|
|
|
|
|
2016-03-04 22:01:47 +00:00
|
|
|
|
(test-assert "package-grafts, same replacement twice"
|
|
|
|
|
|
(let* ((new (dummy-package "dep"
|
|
|
|
|
|
(version "1")
|
|
|
|
|
|
(arguments '(#:implicit-inputs? #f))))
|
|
|
|
|
|
(dep (package (inherit new) (version "0") (replacement new)))
|
|
|
|
|
|
(p1 (dummy-package "intermediate1"
|
|
|
|
|
|
(arguments '(#:implicit-inputs? #f))
|
|
|
|
|
|
(inputs `(("dep" ,dep)))))
|
|
|
|
|
|
(p2 (dummy-package "intermediate2"
|
|
|
|
|
|
(arguments '(#:implicit-inputs? #f))
|
|
|
|
|
|
;; Here we copy DEP to have an equivalent package that is not
|
|
|
|
|
|
;; 'eq?' to DEP. This is similar to what happens with
|
|
|
|
|
|
;; 'package-with-explicit-inputs' & co.
|
|
|
|
|
|
(inputs `(("dep" ,(package (inherit dep)))))))
|
|
|
|
|
|
(p3 (dummy-package "final"
|
|
|
|
|
|
(arguments '(#:implicit-inputs? #f))
|
|
|
|
|
|
(inputs `(("p1" ,p1) ("p2" ,p2))))))
|
|
|
|
|
|
(equal? (package-grafts %store p3)
|
|
|
|
|
|
(list (graft
|
|
|
|
|
|
(origin (package-derivation %store
|
|
|
|
|
|
(package (inherit dep)
|
|
|
|
|
|
(replacement #f))))
|
|
|
|
|
|
(replacement (package-derivation %store new)))))))
|
|
|
|
|
|
|
2020-06-11 16:24:59 +00:00
|
|
|
|
(test-assert "package-grafts, dependency on several outputs"
|
|
|
|
|
|
;; Make sure we get one graft per output; see <https://bugs.gnu.org/41796>.
|
|
|
|
|
|
(letrec* ((p0 (dummy-package "p0"
|
|
|
|
|
|
(version "1.0")
|
|
|
|
|
|
(replacement p0*)
|
|
|
|
|
|
(arguments '(#:implicit-inputs? #f))
|
|
|
|
|
|
(outputs '("out" "lib"))))
|
|
|
|
|
|
(p0* (package (inherit p0) (version "1.1")))
|
|
|
|
|
|
(p1 (dummy-package "p1"
|
|
|
|
|
|
(arguments '(#:implicit-inputs? #f))
|
|
|
|
|
|
(inputs `(("p0" ,p0)
|
|
|
|
|
|
("p0:lib" ,p0 "lib"))))))
|
|
|
|
|
|
(lset= equal? (pk (package-grafts %store p1))
|
|
|
|
|
|
(list (graft
|
|
|
|
|
|
(origin (package-derivation %store p0))
|
|
|
|
|
|
(origin-output "out")
|
|
|
|
|
|
(replacement (package-derivation %store p0*))
|
|
|
|
|
|
(replacement-output "out"))
|
|
|
|
|
|
(graft
|
|
|
|
|
|
(origin (package-derivation %store p0))
|
|
|
|
|
|
(origin-output "lib")
|
|
|
|
|
|
(replacement (package-derivation %store p0*))
|
|
|
|
|
|
(replacement-output "lib"))))))
|
|
|
|
|
|
|
2016-10-14 08:36:37 +00:00
|
|
|
|
(test-assert "replacement also grafted"
|
|
|
|
|
|
;; We build a DAG as below, where dotted arrows represent replacements and
|
|
|
|
|
|
;; solid arrows represent dependencies:
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; P1 ·············> P1R
|
|
|
|
|
|
;; |\__________________.
|
|
|
|
|
|
;; v v
|
|
|
|
|
|
;; P2 ·············> P2R
|
|
|
|
|
|
;; |
|
|
|
|
|
|
;; v
|
|
|
|
|
|
;; P3
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; We want to make sure that:
|
|
|
|
|
|
;; grafts(P3) = (P1,P1R) + (P2, grafted(P2R, (P1,P1R)))
|
|
|
|
|
|
;; where:
|
|
|
|
|
|
;; (A,B) is a graft to replace A by B
|
|
|
|
|
|
;; grafted(DRV,G) denoted DRV with graft G applied
|
|
|
|
|
|
(let* ((p1r (dummy-package "P1"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
|
|
|
|
|
#:builder (let ((out (assoc-ref %outputs "out")))
|
|
|
|
|
|
(mkdir out)
|
|
|
|
|
|
(call-with-output-file
|
|
|
|
|
|
(string-append out "/replacement")
|
|
|
|
|
|
(const #t)))))))
|
|
|
|
|
|
(p1 (package
|
|
|
|
|
|
(inherit p1r) (name "p1") (replacement p1r)
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
2018-03-28 00:05:58 +00:00
|
|
|
|
#:builder (begin
|
|
|
|
|
|
(mkdir (assoc-ref %outputs "out"))
|
|
|
|
|
|
#t)))))
|
2016-10-14 08:36:37 +00:00
|
|
|
|
(p2r (dummy-package "P2"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(inputs `(("p1" ,p1)))
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
|
|
|
|
|
#:builder (let ((out (assoc-ref %outputs "out")))
|
|
|
|
|
|
(mkdir out)
|
|
|
|
|
|
(chdir out)
|
|
|
|
|
|
(symlink (assoc-ref %build-inputs "p1") "p1")
|
|
|
|
|
|
(call-with-output-file (string-append out "/replacement")
|
|
|
|
|
|
(const #t)))))))
|
|
|
|
|
|
(p2 (package
|
|
|
|
|
|
(inherit p2r) (name "p2") (replacement p2r)
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
|
|
|
|
|
#:builder (let ((out (assoc-ref %outputs "out")))
|
|
|
|
|
|
(mkdir out)
|
|
|
|
|
|
(chdir out)
|
|
|
|
|
|
(symlink (assoc-ref %build-inputs "p1")
|
2018-03-28 00:05:58 +00:00
|
|
|
|
"p1")
|
|
|
|
|
|
#t)))))
|
2016-10-14 08:36:37 +00:00
|
|
|
|
(p3 (dummy-package "p3"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(inputs `(("p2" ,p2)))
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
|
|
|
|
|
#:builder (let ((out (assoc-ref %outputs "out")))
|
|
|
|
|
|
(mkdir out)
|
|
|
|
|
|
(chdir out)
|
|
|
|
|
|
(symlink (assoc-ref %build-inputs "p2")
|
2018-03-28 00:05:58 +00:00
|
|
|
|
"p2")
|
|
|
|
|
|
#t))))))
|
2016-10-14 08:36:37 +00:00
|
|
|
|
(lset= equal?
|
|
|
|
|
|
(package-grafts %store p3)
|
|
|
|
|
|
(list (graft
|
|
|
|
|
|
(origin (package-derivation %store p1 #:graft? #f))
|
|
|
|
|
|
(replacement (package-derivation %store p1r)))
|
|
|
|
|
|
(graft
|
|
|
|
|
|
(origin (package-derivation %store p2 #:graft? #f))
|
|
|
|
|
|
(replacement
|
|
|
|
|
|
(package-derivation %store p2r #:graft? #t)))))))
|
|
|
|
|
|
|
2016-02-27 22:06:50 +00:00
|
|
|
|
;;; XXX: Nowadays 'graft-derivation' needs to build derivations beforehand to
|
|
|
|
|
|
;;; find out about their run-time dependencies, so this test is no longer
|
|
|
|
|
|
;;; applicable since it would trigger a full rebuild.
|
|
|
|
|
|
;;
|
|
|
|
|
|
;; (test-assert "package-derivation, indirect grafts"
|
|
|
|
|
|
;; (let* ((new (dummy-package "dep"
|
|
|
|
|
|
;; (arguments '(#:implicit-inputs? #f))))
|
|
|
|
|
|
;; (dep (package (inherit new) (version "0.0")))
|
|
|
|
|
|
;; (dep* (package (inherit dep) (replacement new)))
|
|
|
|
|
|
;; (dummy (dummy-package "dummy"
|
|
|
|
|
|
;; (arguments '(#:implicit-inputs? #f))
|
|
|
|
|
|
;; (inputs `(("dep" ,dep*)))))
|
|
|
|
|
|
;; (guile (package-derivation %store (canonical-package guile-2.0)
|
|
|
|
|
|
;; #:graft? #f)))
|
|
|
|
|
|
;; (equal? (package-derivation %store dummy)
|
|
|
|
|
|
;; (graft-derivation %store
|
|
|
|
|
|
;; (package-derivation %store dummy #:graft? #f)
|
|
|
|
|
|
;; (package-grafts %store dummy)
|
|
|
|
|
|
|
|
|
|
|
|
;; ;; Use the same Guile as 'package-derivation'.
|
|
|
|
|
|
;; #:guile guile))))
|
packages: Implement grafts.
Thanks to Mark H. Weaver <mhw@netris.org> for insightful discussions
and suggestions.
* guix/packages.scm (<package>)[graft]: New field.
(patch-and-repack): Invoke 'package-derivation' with #:graft? #f.
(package-source-derivation): Likewise. Do not use (%guile-for-build)
in call to 'patch-and-repack', and we could end up using a grafted
Guile.
(expand-input): Likewise, also for 'package-cross-derivation' call.
(package->bag): Add #:graft? parameter. Honor it. Use 'strip-append'
instead of 'package-full-name'.
(input-graft, input-cross-graft, bag-grafts, package-grafts): New
procedures.
(package-derivation, package-cross-derivation): Add #:graft? parameter
and honor it.
* gnu/packages/bootstrap.scm (package-with-bootstrap-guile): Add
recursive call on 'graft'.
* guix/build-system/gnu.scm (package-with-explicit-inputs,
package-with-extra-configure-variable, static-package): Likewise.
(gnu-build): Use the ungrafted Guile to avoid full rebuilds.
(gnu-cross-build): Likewise.
* guix/build-system/cmake.scm (cmake-build): Likewise.
* guix/build-system/glib-or-gtk.scm (glib-or-gtk-build): Likewise.
* guix/build-system/perl.scm (perl-build): Likewise.
* guix/build-system/python.scm (python-build): Likewise.
* guix/build-system/ruby.scm (ruby-build): Likewise.
* guix/build-system/trivial.scm (guile-for-build): Likewise.
* tests/packages.scm ("package-derivation, direct graft",
"package-cross-derivation, direct graft", "package-grafts,
indirect grafts", "package-grafts, indirect grafts, cross",
"package-grafts, indirect grafts, propagated inputs",
"package-derivation, indirect grafts"): New tests.
("bag->derivation", "bag->derivation, cross-compilation"): Wrap in
'parameterize'.
* doc/guix.texi (Security Updates): New node.
(Invoking guix build): Document --no-graft.
2014-10-27 17:09:00 +00:00
|
|
|
|
|
2014-10-05 14:32:25 +00:00
|
|
|
|
(test-equal "package->bag"
|
|
|
|
|
|
`("foo86-hurd" #f (,(package-source gnu-make))
|
|
|
|
|
|
(,(canonical-package glibc)) (,(canonical-package coreutils)))
|
|
|
|
|
|
(let ((bag (package->bag gnu-make "foo86-hurd")))
|
|
|
|
|
|
(list (bag-system bag) (bag-target bag)
|
|
|
|
|
|
(assoc-ref (bag-build-inputs bag) "source")
|
|
|
|
|
|
(assoc-ref (bag-build-inputs bag) "libc")
|
|
|
|
|
|
(assoc-ref (bag-build-inputs bag) "coreutils"))))
|
|
|
|
|
|
|
2020-06-06 19:37:47 +00:00
|
|
|
|
(test-assert "package->bag, sensitivity to %current-target-system"
|
|
|
|
|
|
;; https://bugs.gnu.org/41713
|
|
|
|
|
|
(let* ((lower (lambda* (name #:key system target inputs native-inputs
|
|
|
|
|
|
#:allow-other-keys)
|
|
|
|
|
|
(and (not target)
|
|
|
|
|
|
(bag (name name) (system system) (target target)
|
|
|
|
|
|
(build-inputs native-inputs)
|
|
|
|
|
|
(host-inputs inputs)
|
|
|
|
|
|
(build (lambda* (store name inputs
|
|
|
|
|
|
#:key system target
|
|
|
|
|
|
#:allow-other-keys)
|
|
|
|
|
|
(build-expression->derivation
|
|
|
|
|
|
store "foo" '(mkdir %output))))))))
|
|
|
|
|
|
(bs (build-system
|
|
|
|
|
|
(name 'build-system-without-cross-compilation)
|
|
|
|
|
|
(description "Does not support cross compilation.")
|
|
|
|
|
|
(lower lower)))
|
|
|
|
|
|
(dep (dummy-package "dep" (build-system bs)))
|
|
|
|
|
|
(pkg (dummy-package "example"
|
|
|
|
|
|
(native-inputs `(("dep" ,dep)))))
|
|
|
|
|
|
(do-not-build (lambda (continue store lst . _) lst)))
|
|
|
|
|
|
(equal? (with-build-handler do-not-build
|
|
|
|
|
|
(parameterize ((%current-target-system "powerpc64le-linux-gnu")
|
|
|
|
|
|
(%graft? #t))
|
|
|
|
|
|
(package-cross-derivation %store pkg
|
|
|
|
|
|
(%current-target-system)
|
|
|
|
|
|
#:graft? #t)))
|
|
|
|
|
|
(with-build-handler do-not-build
|
|
|
|
|
|
(package-cross-derivation %store
|
|
|
|
|
|
(package (inherit pkg))
|
|
|
|
|
|
"powerpc64le-linux-gnu"
|
|
|
|
|
|
#:graft? #t)))))
|
|
|
|
|
|
|
2014-10-05 14:32:25 +00:00
|
|
|
|
(test-equal "package->bag, cross-compilation"
|
|
|
|
|
|
`(,(%current-system) "foo86-hurd"
|
|
|
|
|
|
(,(package-source gnu-make))
|
|
|
|
|
|
(,(canonical-package glibc)) (,(canonical-package coreutils)))
|
|
|
|
|
|
(let ((bag (package->bag gnu-make (%current-system) "foo86-hurd")))
|
|
|
|
|
|
(list (bag-system bag) (bag-target bag)
|
|
|
|
|
|
(assoc-ref (bag-build-inputs bag) "source")
|
|
|
|
|
|
(assoc-ref (bag-build-inputs bag) "libc")
|
|
|
|
|
|
(assoc-ref (bag-build-inputs bag) "coreutils"))))
|
|
|
|
|
|
|
2014-10-16 21:22:07 +00:00
|
|
|
|
(test-assert "package->bag, propagated inputs"
|
|
|
|
|
|
(let* ((dep (dummy-package "dep"))
|
|
|
|
|
|
(prop (dummy-package "prop"
|
|
|
|
|
|
(propagated-inputs `(("dep" ,dep)))))
|
|
|
|
|
|
(dummy (dummy-package "dummy"
|
|
|
|
|
|
(inputs `(("prop" ,prop)))))
|
|
|
|
|
|
(inputs (bag-transitive-inputs (package->bag dummy #:graft? #f))))
|
packages: Rewrite 'transitive-inputs' to be linear and remove duplicates.
There were two issues:
1. Use of 'delete-duplicates', which is quadratic, was a serious problem for
closures with lots of propagated inputs, such as that of the 'hydra'
package (several minutes for 'guix build hydra -n'!).
2. The 'delete-duplicates' call essentially had no effect since duplicate
inputs typically had a different label and were thus kept. For
instance, (bag-transitive-inputs (package->bag inkscape)) would return
216 items whereas (delete-duplicates (map cdr THAT)) contains only 67
items.
The new implementation returns 67 items in this case. For 'hydra', we're
down from 42211 items to 361, and roughly 13s for 'guix build hydra'.
* guix/packages.scm (transitive-inputs): Rewrite as a breadth-first
traversal. Remove duplicate propagated inputs.
* tests/packages.scm ("package-transitive-inputs", "package->bag, propagated
inputs"): Adjust to use simple labels for propagated inputs, without "/".
("package-transitive-inputs, no duplicates"): New test.
2015-07-11 21:13:24 +00:00
|
|
|
|
(match (assoc "dep" inputs)
|
|
|
|
|
|
(("dep" package)
|
2014-10-16 21:22:07 +00:00
|
|
|
|
(eq? package dep)))))
|
|
|
|
|
|
|
2020-07-13 14:43:58 +00:00
|
|
|
|
(test-assert "package->bag, sensitivity to %current-system"
|
|
|
|
|
|
(let* ((dep (dummy-package "dep"
|
|
|
|
|
|
(propagated-inputs (if (string=? (%current-system)
|
|
|
|
|
|
"i586-gnu")
|
|
|
|
|
|
`(("libxml2" ,libxml2))
|
|
|
|
|
|
'()))))
|
|
|
|
|
|
(pkg (dummy-package "foo"
|
|
|
|
|
|
(native-inputs `(("dep" ,dep)))))
|
|
|
|
|
|
(bag (package->bag pkg (%current-system) "i586-gnu")))
|
|
|
|
|
|
(equal? (parameterize ((%current-system "x86_64-linux"))
|
|
|
|
|
|
(bag-transitive-inputs bag))
|
|
|
|
|
|
(parameterize ((%current-system "i586-gnu"))
|
|
|
|
|
|
(bag-transitive-inputs bag)))))
|
|
|
|
|
|
|
2020-05-14 14:03:56 +00:00
|
|
|
|
(test-assert "package->bag, sensitivity to %current-target-system"
|
|
|
|
|
|
(let* ((dep (dummy-package "dep"
|
|
|
|
|
|
(propagated-inputs (if (%current-target-system)
|
|
|
|
|
|
`(("libxml2" ,libxml2))
|
|
|
|
|
|
'()))))
|
|
|
|
|
|
(pkg (dummy-package "foo"
|
|
|
|
|
|
(native-inputs `(("dep" ,dep)))))
|
|
|
|
|
|
(bag (package->bag pkg (%current-system) "foo86-hurd")))
|
|
|
|
|
|
(equal? (parameterize ((%current-target-system "foo64-gnu"))
|
|
|
|
|
|
(bag-transitive-inputs bag))
|
|
|
|
|
|
(parameterize ((%current-target-system #f))
|
|
|
|
|
|
(bag-transitive-inputs bag)))))
|
|
|
|
|
|
|
2014-10-05 14:32:25 +00:00
|
|
|
|
(test-assert "bag->derivation"
|
packages: Implement grafts.
Thanks to Mark H. Weaver <mhw@netris.org> for insightful discussions
and suggestions.
* guix/packages.scm (<package>)[graft]: New field.
(patch-and-repack): Invoke 'package-derivation' with #:graft? #f.
(package-source-derivation): Likewise. Do not use (%guile-for-build)
in call to 'patch-and-repack', and we could end up using a grafted
Guile.
(expand-input): Likewise, also for 'package-cross-derivation' call.
(package->bag): Add #:graft? parameter. Honor it. Use 'strip-append'
instead of 'package-full-name'.
(input-graft, input-cross-graft, bag-grafts, package-grafts): New
procedures.
(package-derivation, package-cross-derivation): Add #:graft? parameter
and honor it.
* gnu/packages/bootstrap.scm (package-with-bootstrap-guile): Add
recursive call on 'graft'.
* guix/build-system/gnu.scm (package-with-explicit-inputs,
package-with-extra-configure-variable, static-package): Likewise.
(gnu-build): Use the ungrafted Guile to avoid full rebuilds.
(gnu-cross-build): Likewise.
* guix/build-system/cmake.scm (cmake-build): Likewise.
* guix/build-system/glib-or-gtk.scm (glib-or-gtk-build): Likewise.
* guix/build-system/perl.scm (perl-build): Likewise.
* guix/build-system/python.scm (python-build): Likewise.
* guix/build-system/ruby.scm (ruby-build): Likewise.
* guix/build-system/trivial.scm (guile-for-build): Likewise.
* tests/packages.scm ("package-derivation, direct graft",
"package-cross-derivation, direct graft", "package-grafts,
indirect grafts", "package-grafts, indirect grafts, cross",
"package-grafts, indirect grafts, propagated inputs",
"package-derivation, indirect grafts"): New tests.
("bag->derivation", "bag->derivation, cross-compilation"): Wrap in
'parameterize'.
* doc/guix.texi (Security Updates): New node.
(Invoking guix build): Document --no-graft.
2014-10-27 17:09:00 +00:00
|
|
|
|
(parameterize ((%graft? #f))
|
|
|
|
|
|
(let ((bag (package->bag gnu-make))
|
|
|
|
|
|
(drv (package-derivation %store gnu-make)))
|
|
|
|
|
|
(parameterize ((%current-system "foox86-hurd")) ;should have no effect
|
|
|
|
|
|
(equal? drv (bag->derivation %store bag))))))
|
2014-10-05 14:32:25 +00:00
|
|
|
|
|
|
|
|
|
|
(test-assert "bag->derivation, cross-compilation"
|
packages: Implement grafts.
Thanks to Mark H. Weaver <mhw@netris.org> for insightful discussions
and suggestions.
* guix/packages.scm (<package>)[graft]: New field.
(patch-and-repack): Invoke 'package-derivation' with #:graft? #f.
(package-source-derivation): Likewise. Do not use (%guile-for-build)
in call to 'patch-and-repack', and we could end up using a grafted
Guile.
(expand-input): Likewise, also for 'package-cross-derivation' call.
(package->bag): Add #:graft? parameter. Honor it. Use 'strip-append'
instead of 'package-full-name'.
(input-graft, input-cross-graft, bag-grafts, package-grafts): New
procedures.
(package-derivation, package-cross-derivation): Add #:graft? parameter
and honor it.
* gnu/packages/bootstrap.scm (package-with-bootstrap-guile): Add
recursive call on 'graft'.
* guix/build-system/gnu.scm (package-with-explicit-inputs,
package-with-extra-configure-variable, static-package): Likewise.
(gnu-build): Use the ungrafted Guile to avoid full rebuilds.
(gnu-cross-build): Likewise.
* guix/build-system/cmake.scm (cmake-build): Likewise.
* guix/build-system/glib-or-gtk.scm (glib-or-gtk-build): Likewise.
* guix/build-system/perl.scm (perl-build): Likewise.
* guix/build-system/python.scm (python-build): Likewise.
* guix/build-system/ruby.scm (ruby-build): Likewise.
* guix/build-system/trivial.scm (guile-for-build): Likewise.
* tests/packages.scm ("package-derivation, direct graft",
"package-cross-derivation, direct graft", "package-grafts,
indirect grafts", "package-grafts, indirect grafts, cross",
"package-grafts, indirect grafts, propagated inputs",
"package-derivation, indirect grafts"): New tests.
("bag->derivation", "bag->derivation, cross-compilation"): Wrap in
'parameterize'.
* doc/guix.texi (Security Updates): New node.
(Invoking guix build): Document --no-graft.
2014-10-27 17:09:00 +00:00
|
|
|
|
(parameterize ((%graft? #f))
|
|
|
|
|
|
(let* ((target "mips64el-linux-gnu")
|
|
|
|
|
|
(bag (package->bag gnu-make (%current-system) target))
|
|
|
|
|
|
(drv (package-cross-derivation %store gnu-make target)))
|
|
|
|
|
|
(parameterize ((%current-system "foox86-hurd") ;should have no effect
|
|
|
|
|
|
(%current-target-system "foo64-linux-gnu"))
|
|
|
|
|
|
(equal? drv (bag->derivation %store bag))))))
|
2014-10-05 14:32:25 +00:00
|
|
|
|
|
2015-02-23 22:52:28 +00:00
|
|
|
|
(when (or (not (network-reachable?)) (shebang-too-long?))
|
|
|
|
|
|
(test-skip 1))
|
2012-11-09 22:59:11 +00:00
|
|
|
|
(test-assert "GNU Make, bootstrap"
|
2019-06-14 19:26:22 +00:00
|
|
|
|
;; GNU-MAKE-FOR-TESTS can be built cheaply; we choose it here so that the
|
|
|
|
|
|
;; test doesn't last for too long.
|
|
|
|
|
|
(let ((gnu-make gnu-make-for-tests))
|
2012-11-09 22:59:11 +00:00
|
|
|
|
(and (package? gnu-make)
|
|
|
|
|
|
(or (location? (package-location gnu-make))
|
|
|
|
|
|
(not (package-location gnu-make)))
|
|
|
|
|
|
(let* ((drv (package-derivation %store gnu-make))
|
derivations: 'derivation' and related procedures return a single value.
* guix/derivations.scm (derivation->output-path,
derivation->output-paths): New procedures.
(derivation-path->output-path): Use 'derivation->output-path'.
(derivation-path->output-paths): Use 'derivation->output-paths'.
(derivation): Accept 'derivation?' objects as inputs. Return a single
value.
(build-derivations): New procedure.
(compiled-modules): Use 'derivation->output-paths'.
(build-expression->derivation)[source-path]: Add case for when the
input matches 'derivation?'.
[prologue]: Accept 'derivation?' objects in INPUTS.
[mod-dir, go-dir]: Use 'derivation->output-path'.
* guix/download.scm (url-fetch): Adjust to the single-value return.
* guix/packages.scm (package-output): Use 'derivation->output-path'.
* guix/scripts/build.scm (guix-build): When the argument is
'derivation-path?', pass it through 'read-derivation'.
Use 'derivation-file-name' to print out the .drv file names, and to
register them. Use 'derivation->output-path' instead of
'derivation-path->output-path'.
* guix/scripts/package.scm (roll-back): Adjust to the single-value
return.
(guix-package): Use 'derivation->output-path'.
* guix/ui.scm (show-what-to-build): Adjust to deal with 'derivation?'
objects instead of .drv file names.
* gnu/system/grub.scm (grub-configuration-file): Use
'derivation->output-path' instead of 'derivation-path->output-path'.
* gnu/system/vm.scm (qemu-image, system-qemu-image): Likewise.
* tests/builders.scm, tests/derivations.scm, tests/packages.scm,
tests/store.scm, tests/union.scm: Adjust to the new calling
convention.
* doc/guix.texi (Defining Packages, The Store, Derivations): Adjust
accordingly.
2013-09-18 15:01:40 +00:00
|
|
|
|
(out (derivation->output-path drv)))
|
2012-10-05 23:24:46 +00:00
|
|
|
|
(and (build-derivations %store (list drv))
|
2012-11-09 22:59:11 +00:00
|
|
|
|
(file-exists? (string-append out "/bin/make")))))))
|
2012-06-27 23:24:34 +00:00
|
|
|
|
|
2017-04-05 13:19:15 +00:00
|
|
|
|
(test-equal "package-mapping"
|
|
|
|
|
|
42
|
|
|
|
|
|
(let* ((dep (dummy-package "chbouib"
|
|
|
|
|
|
(native-inputs `(("x" ,grep)))))
|
|
|
|
|
|
(p0 (dummy-package "example"
|
2020-09-21 15:44:29 +00:00
|
|
|
|
(source 77)
|
2017-04-05 13:19:15 +00:00
|
|
|
|
(inputs `(("foo" ,coreutils)
|
|
|
|
|
|
("bar" ,grep)
|
|
|
|
|
|
("baz" ,dep)))))
|
|
|
|
|
|
(transform (lambda (p)
|
|
|
|
|
|
(package (inherit p) (source 42))))
|
|
|
|
|
|
(rewrite (package-mapping transform))
|
2020-09-21 15:44:29 +00:00
|
|
|
|
(p1 (rewrite p0))
|
|
|
|
|
|
(bag0 (package->bag p0))
|
|
|
|
|
|
(bag1 (package->bag p1)))
|
2017-04-05 13:19:15 +00:00
|
|
|
|
(and (eq? p1 (rewrite p0))
|
|
|
|
|
|
(eqv? 42 (package-source p1))
|
2020-09-21 15:44:29 +00:00
|
|
|
|
|
|
|
|
|
|
;; Implicit inputs should be left unchanged (skip "source", "foo",
|
|
|
|
|
|
;; "bar", and "baz" in this comparison).
|
|
|
|
|
|
(equal? (drop (bag-direct-inputs bag0) 4)
|
|
|
|
|
|
(drop (bag-direct-inputs bag1) 4))
|
|
|
|
|
|
|
2017-04-05 13:19:15 +00:00
|
|
|
|
(match (package-inputs p1)
|
|
|
|
|
|
((("foo" dep1) ("bar" dep2) ("baz" dep3))
|
|
|
|
|
|
(and (eq? dep1 (rewrite coreutils)) ;memoization
|
|
|
|
|
|
(eq? dep2 (rewrite grep))
|
|
|
|
|
|
(eq? dep3 (rewrite dep))
|
|
|
|
|
|
(eqv? 42
|
|
|
|
|
|
(package-source dep1) (package-source dep2)
|
|
|
|
|
|
(package-source dep3))
|
|
|
|
|
|
(match (package-native-inputs dep3)
|
|
|
|
|
|
((("x" dep))
|
|
|
|
|
|
(and (eq? dep (rewrite grep))
|
|
|
|
|
|
(package-source dep))))))))))
|
|
|
|
|
|
|
2020-09-21 15:44:29 +00:00
|
|
|
|
(test-equal "package-mapping, deep"
|
|
|
|
|
|
'(42)
|
|
|
|
|
|
(let* ((p0 (dummy-package "example"
|
|
|
|
|
|
(inputs `(("foo" ,coreutils)
|
|
|
|
|
|
("bar" ,grep)))))
|
|
|
|
|
|
(transform (lambda (p)
|
|
|
|
|
|
(package (inherit p) (source 42))))
|
|
|
|
|
|
(rewrite (package-mapping transform #:deep? #t))
|
|
|
|
|
|
(p1 (rewrite p0))
|
|
|
|
|
|
(bag (package->bag p1)))
|
|
|
|
|
|
(and (eq? p1 (rewrite p0))
|
|
|
|
|
|
(match (bag-direct-inputs bag)
|
|
|
|
|
|
((("source" 42) ("foo" dep1) ("bar" dep2) rest ..1)
|
|
|
|
|
|
(and (eq? dep1 (rewrite coreutils)) ;memoization
|
|
|
|
|
|
(eq? dep2 (rewrite grep))
|
|
|
|
|
|
(= 42 (package-source dep1))
|
|
|
|
|
|
(= 42 (package-source dep2))
|
|
|
|
|
|
|
|
|
|
|
|
;; Check that implicit inputs of P0 also got rewritten.
|
|
|
|
|
|
(delete-duplicates
|
|
|
|
|
|
(map (match-lambda
|
|
|
|
|
|
((_ package . _)
|
|
|
|
|
|
(package-source package)))
|
|
|
|
|
|
rest))))))))
|
|
|
|
|
|
|
2016-09-01 20:35:35 +00:00
|
|
|
|
(test-assert "package-input-rewriting"
|
|
|
|
|
|
(let* ((dep (dummy-package "chbouib"
|
|
|
|
|
|
(native-inputs `(("x" ,grep)))))
|
|
|
|
|
|
(p0 (dummy-package "example"
|
|
|
|
|
|
(inputs `(("foo" ,coreutils)
|
|
|
|
|
|
("bar" ,grep)
|
|
|
|
|
|
("baz" ,dep)))))
|
|
|
|
|
|
(rewrite (package-input-rewriting `((,coreutils . ,sed)
|
|
|
|
|
|
(,grep . ,findutils))
|
2020-09-23 12:56:38 +00:00
|
|
|
|
(cut string-append "r-" <>)
|
|
|
|
|
|
#:deep? #f))
|
2016-09-01 20:35:35 +00:00
|
|
|
|
(p1 (rewrite p0))
|
|
|
|
|
|
(p2 (rewrite p0)))
|
|
|
|
|
|
(and (not (eq? p1 p0))
|
|
|
|
|
|
(eq? p1 p2) ;memoization
|
|
|
|
|
|
(string=? "r-example" (package-name p1))
|
|
|
|
|
|
(match (package-inputs p1)
|
|
|
|
|
|
((("foo" dep1) ("bar" dep2) ("baz" dep3))
|
|
|
|
|
|
(and (eq? dep1 sed)
|
|
|
|
|
|
(eq? dep2 findutils)
|
|
|
|
|
|
(string=? (package-name dep3) "r-chbouib")
|
|
|
|
|
|
(eq? dep3 (rewrite dep)) ;memoization
|
|
|
|
|
|
(match (package-native-inputs dep3)
|
|
|
|
|
|
((("x" dep))
|
2020-09-23 12:56:38 +00:00
|
|
|
|
(eq? dep findutils))))))
|
|
|
|
|
|
|
|
|
|
|
|
;; Make sure implicit inputs were left unchanged.
|
|
|
|
|
|
(equal? (drop (bag-direct-inputs (package->bag p1)) 3)
|
|
|
|
|
|
(drop (bag-direct-inputs (package->bag p0)) 3)))))
|
|
|
|
|
|
|
|
|
|
|
|
(test-eq "package-input-rewriting, deep"
|
|
|
|
|
|
(derivation-file-name (package-derivation %store sed))
|
|
|
|
|
|
(let* ((p0 (dummy-package "chbouib"
|
|
|
|
|
|
(build-system python-build-system)
|
|
|
|
|
|
(arguments `(#:python ,python))))
|
|
|
|
|
|
(rewrite (package-input-rewriting `((,python . ,sed))))
|
|
|
|
|
|
(p1 (rewrite p0)))
|
|
|
|
|
|
(match (bag-direct-inputs (package->bag p1))
|
|
|
|
|
|
((("python" python) _ ...)
|
|
|
|
|
|
(derivation-file-name (package-derivation %store python))))))
|
2016-09-01 20:35:35 +00:00
|
|
|
|
|
2019-03-12 20:39:48 +00:00
|
|
|
|
(test-assert "package-input-rewriting/spec"
|
|
|
|
|
|
(let* ((dep (dummy-package "chbouib"
|
|
|
|
|
|
(native-inputs `(("x" ,grep)))))
|
|
|
|
|
|
(p0 (dummy-package "example"
|
|
|
|
|
|
(inputs `(("foo" ,coreutils)
|
|
|
|
|
|
("bar" ,grep)
|
|
|
|
|
|
("baz" ,dep)))))
|
|
|
|
|
|
(rewrite (package-input-rewriting/spec
|
|
|
|
|
|
`(("coreutils" . ,(const sed))
|
packages: 'package-input-rewriting/spec' can rewrite implicit dependencies.
With this change, '--with-input', '--with-graft', etc. also apply to
implicit dependencies. Thus, it's now possible to do:
guix build python-itsdangerous --with-input=python-wrapper=python@2
or:
guix build hello --with-graft=glibc=glibc@2.29
Additionally, before, implicit inputs were not rewritten, which could
lead to duplicates in the output of 'bag-transitive-inputs' (packages
that are not 'eq?' but lead to the same derivation). This in turn would
lead to unnecessary rebuilds when using '--with-input' & co. This
change fixes it by ensuring even implicit inputs are rewritten.
Fixes <https://bugs.gnu.org/42156>.
* guix/packages.scm (package-input-rewriting/spec): Add #:deep?
defaulting to #true, and pass it to 'package-mapping'.
[replacement-property]: New variable.
[rewrite]: Check that property and set it on the result of PROC.
[cut?]: New procedure.
* tests/packages.scm ("package-input-rewriting/spec"): Ensure implicit
inputs were unchanged.
("package-input-rewriting/spec, partial match"): Pass #:deep? #f.
("package-input-rewriting/spec, deep")
("package-input-rewriting/spec, no duplicates"): New tests.
(package/inherit): Move before use.
* tests/guix-build.sh: Add tests.
* tests/scripts-build.scm ("options->transformation, with-graft"):
Compare dependencies by package name or derivation file name.
* doc/guix.texi (Defining Packages): Adjust accordingly.
2020-09-23 08:29:09 +00:00
|
|
|
|
("grep" . ,(const findutils)))
|
|
|
|
|
|
#:deep? #f))
|
2019-03-12 20:39:48 +00:00
|
|
|
|
(p1 (rewrite p0))
|
|
|
|
|
|
(p2 (rewrite p0)))
|
|
|
|
|
|
(and (not (eq? p1 p0))
|
|
|
|
|
|
(eq? p1 p2) ;memoization
|
|
|
|
|
|
(string=? "example" (package-name p1))
|
|
|
|
|
|
(match (package-inputs p1)
|
|
|
|
|
|
((("foo" dep1) ("bar" dep2) ("baz" dep3))
|
|
|
|
|
|
(and (string=? (package-full-name dep1)
|
|
|
|
|
|
(package-full-name sed))
|
|
|
|
|
|
(string=? (package-full-name dep2)
|
|
|
|
|
|
(package-full-name findutils))
|
|
|
|
|
|
(string=? (package-name dep3) "chbouib")
|
|
|
|
|
|
(eq? dep3 (rewrite dep)) ;memoization
|
|
|
|
|
|
(match (package-native-inputs dep3)
|
|
|
|
|
|
((("x" dep))
|
|
|
|
|
|
(string=? (package-full-name dep)
|
packages: 'package-input-rewriting/spec' can rewrite implicit dependencies.
With this change, '--with-input', '--with-graft', etc. also apply to
implicit dependencies. Thus, it's now possible to do:
guix build python-itsdangerous --with-input=python-wrapper=python@2
or:
guix build hello --with-graft=glibc=glibc@2.29
Additionally, before, implicit inputs were not rewritten, which could
lead to duplicates in the output of 'bag-transitive-inputs' (packages
that are not 'eq?' but lead to the same derivation). This in turn would
lead to unnecessary rebuilds when using '--with-input' & co. This
change fixes it by ensuring even implicit inputs are rewritten.
Fixes <https://bugs.gnu.org/42156>.
* guix/packages.scm (package-input-rewriting/spec): Add #:deep?
defaulting to #true, and pass it to 'package-mapping'.
[replacement-property]: New variable.
[rewrite]: Check that property and set it on the result of PROC.
[cut?]: New procedure.
* tests/packages.scm ("package-input-rewriting/spec"): Ensure implicit
inputs were unchanged.
("package-input-rewriting/spec, partial match"): Pass #:deep? #f.
("package-input-rewriting/spec, deep")
("package-input-rewriting/spec, no duplicates"): New tests.
(package/inherit): Move before use.
* tests/guix-build.sh: Add tests.
* tests/scripts-build.scm ("options->transformation, with-graft"):
Compare dependencies by package name or derivation file name.
* doc/guix.texi (Defining Packages): Adjust accordingly.
2020-09-23 08:29:09 +00:00
|
|
|
|
(package-full-name findutils)))))))
|
|
|
|
|
|
|
|
|
|
|
|
;; Make sure implicit inputs were left unchanged.
|
|
|
|
|
|
(equal? (drop (bag-direct-inputs (package->bag p1)) 3)
|
|
|
|
|
|
(drop (bag-direct-inputs (package->bag p0)) 3)))))
|
2019-03-12 20:39:48 +00:00
|
|
|
|
|
|
|
|
|
|
(test-assert "package-input-rewriting/spec, partial match"
|
|
|
|
|
|
(let* ((dep (dummy-package "chbouib"
|
|
|
|
|
|
(version "1")
|
|
|
|
|
|
(native-inputs `(("x" ,grep)))))
|
|
|
|
|
|
(p0 (dummy-package "example"
|
|
|
|
|
|
(inputs `(("foo" ,coreutils)
|
|
|
|
|
|
("bar" ,dep)))))
|
|
|
|
|
|
(rewrite (package-input-rewriting/spec
|
|
|
|
|
|
`(("chbouib@123" . ,(const sed)) ;not matched
|
packages: 'package-input-rewriting/spec' can rewrite implicit dependencies.
With this change, '--with-input', '--with-graft', etc. also apply to
implicit dependencies. Thus, it's now possible to do:
guix build python-itsdangerous --with-input=python-wrapper=python@2
or:
guix build hello --with-graft=glibc=glibc@2.29
Additionally, before, implicit inputs were not rewritten, which could
lead to duplicates in the output of 'bag-transitive-inputs' (packages
that are not 'eq?' but lead to the same derivation). This in turn would
lead to unnecessary rebuilds when using '--with-input' & co. This
change fixes it by ensuring even implicit inputs are rewritten.
Fixes <https://bugs.gnu.org/42156>.
* guix/packages.scm (package-input-rewriting/spec): Add #:deep?
defaulting to #true, and pass it to 'package-mapping'.
[replacement-property]: New variable.
[rewrite]: Check that property and set it on the result of PROC.
[cut?]: New procedure.
* tests/packages.scm ("package-input-rewriting/spec"): Ensure implicit
inputs were unchanged.
("package-input-rewriting/spec, partial match"): Pass #:deep? #f.
("package-input-rewriting/spec, deep")
("package-input-rewriting/spec, no duplicates"): New tests.
(package/inherit): Move before use.
* tests/guix-build.sh: Add tests.
* tests/scripts-build.scm ("options->transformation, with-graft"):
Compare dependencies by package name or derivation file name.
* doc/guix.texi (Defining Packages): Adjust accordingly.
2020-09-23 08:29:09 +00:00
|
|
|
|
("grep" . ,(const findutils)))
|
|
|
|
|
|
#:deep? #f))
|
2019-03-12 20:39:48 +00:00
|
|
|
|
(p1 (rewrite p0)))
|
|
|
|
|
|
(and (not (eq? p1 p0))
|
|
|
|
|
|
(string=? "example" (package-name p1))
|
|
|
|
|
|
(match (package-inputs p1)
|
|
|
|
|
|
((("foo" dep1) ("bar" dep2))
|
|
|
|
|
|
(and (string=? (package-full-name dep1)
|
|
|
|
|
|
(package-full-name coreutils))
|
|
|
|
|
|
(eq? dep2 (rewrite dep)) ;memoization
|
|
|
|
|
|
(match (package-native-inputs dep2)
|
|
|
|
|
|
((("x" dep))
|
|
|
|
|
|
(string=? (package-full-name dep)
|
|
|
|
|
|
(package-full-name findutils))))))))))
|
|
|
|
|
|
|
packages: 'package-input-rewriting/spec' can rewrite implicit dependencies.
With this change, '--with-input', '--with-graft', etc. also apply to
implicit dependencies. Thus, it's now possible to do:
guix build python-itsdangerous --with-input=python-wrapper=python@2
or:
guix build hello --with-graft=glibc=glibc@2.29
Additionally, before, implicit inputs were not rewritten, which could
lead to duplicates in the output of 'bag-transitive-inputs' (packages
that are not 'eq?' but lead to the same derivation). This in turn would
lead to unnecessary rebuilds when using '--with-input' & co. This
change fixes it by ensuring even implicit inputs are rewritten.
Fixes <https://bugs.gnu.org/42156>.
* guix/packages.scm (package-input-rewriting/spec): Add #:deep?
defaulting to #true, and pass it to 'package-mapping'.
[replacement-property]: New variable.
[rewrite]: Check that property and set it on the result of PROC.
[cut?]: New procedure.
* tests/packages.scm ("package-input-rewriting/spec"): Ensure implicit
inputs were unchanged.
("package-input-rewriting/spec, partial match"): Pass #:deep? #f.
("package-input-rewriting/spec, deep")
("package-input-rewriting/spec, no duplicates"): New tests.
(package/inherit): Move before use.
* tests/guix-build.sh: Add tests.
* tests/scripts-build.scm ("options->transformation, with-graft"):
Compare dependencies by package name or derivation file name.
* doc/guix.texi (Defining Packages): Adjust accordingly.
2020-09-23 08:29:09 +00:00
|
|
|
|
(test-assert "package-input-rewriting/spec, deep"
|
|
|
|
|
|
(let* ((dep (dummy-package "chbouib"))
|
|
|
|
|
|
(p0 (dummy-package "example"
|
|
|
|
|
|
(build-system gnu-build-system)
|
|
|
|
|
|
(inputs `(("dep" ,dep)))))
|
|
|
|
|
|
(rewrite (package-input-rewriting/spec
|
|
|
|
|
|
`(("tar" . ,(const sed))
|
|
|
|
|
|
("gzip" . ,(const findutils)))))
|
|
|
|
|
|
(p1 (rewrite p0))
|
|
|
|
|
|
(p2 (rewrite p0)))
|
|
|
|
|
|
(and (not (eq? p1 p0))
|
|
|
|
|
|
(eq? p1 p2) ;memoization
|
|
|
|
|
|
(string=? "example" (package-name p1))
|
|
|
|
|
|
(match (package-inputs p1)
|
|
|
|
|
|
((("dep" dep1))
|
|
|
|
|
|
(and (string=? (package-full-name dep1)
|
|
|
|
|
|
(package-full-name dep))
|
|
|
|
|
|
(eq? dep1 (rewrite dep))))) ;memoization
|
|
|
|
|
|
|
|
|
|
|
|
;; Make sure implicit inputs were replaced.
|
|
|
|
|
|
(match (bag-direct-inputs (package->bag p1))
|
|
|
|
|
|
((("dep" dep1) ("tar" tar) ("gzip" gzip) _ ...)
|
|
|
|
|
|
(and (eq? dep1 (rewrite dep))
|
|
|
|
|
|
(string=? (package-full-name tar)
|
|
|
|
|
|
(package-full-name sed))
|
|
|
|
|
|
(string=? (package-full-name gzip)
|
|
|
|
|
|
(package-full-name findutils))))))))
|
|
|
|
|
|
|
|
|
|
|
|
(test-assert "package-input-rewriting/spec, no duplicates"
|
|
|
|
|
|
;; Ensure that deep input rewriting does not forget implicit inputs. Doing
|
|
|
|
|
|
;; so could lead to duplicates in a package's inputs: in the example below,
|
|
|
|
|
|
;; P0's transitive inputs would contain one rewritten "python" and one
|
|
|
|
|
|
;; original "python". These two "python" packages are thus not 'eq?' but
|
|
|
|
|
|
;; they lower to the same derivation. See <https://bugs.gnu.org/42156>,
|
|
|
|
|
|
;; which can be reproduced by passing #:deep? #f.
|
|
|
|
|
|
(let* ((dep0 (dummy-package "dep0"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(propagated-inputs `(("python" ,python)))))
|
|
|
|
|
|
(p0 (dummy-package "chbouib"
|
|
|
|
|
|
(build-system python-build-system)
|
|
|
|
|
|
(arguments `(#:python ,python))
|
|
|
|
|
|
(inputs `(("dep0" ,dep0)))))
|
|
|
|
|
|
(rewrite (package-input-rewriting/spec '() #:deep? #t))
|
|
|
|
|
|
(p1 (rewrite p0))
|
|
|
|
|
|
(bag1 (package->bag p1))
|
|
|
|
|
|
(pythons (filter-map (match-lambda
|
|
|
|
|
|
(("python" python) python)
|
|
|
|
|
|
(_ #f))
|
|
|
|
|
|
(bag-transitive-inputs bag1))))
|
|
|
|
|
|
(match (delete-duplicates pythons eq?)
|
|
|
|
|
|
((p) (eq? p (rewrite python))))))
|
|
|
|
|
|
|
2020-09-23 12:40:15 +00:00
|
|
|
|
(test-equal "package-input-rewriting/spec, graft"
|
|
|
|
|
|
(derivation-file-name (package-derivation %store sed))
|
|
|
|
|
|
|
|
|
|
|
|
;; Make sure replacements are rewritten.
|
|
|
|
|
|
(let* ((dep0 (dummy-package "dep"
|
|
|
|
|
|
(version "1")
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(inputs `(("coreutils" ,coreutils)))))
|
|
|
|
|
|
(dep1 (dummy-package "dep"
|
|
|
|
|
|
(version "0")
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(replacement dep0)))
|
|
|
|
|
|
(p0 (dummy-package "p"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(inputs `(("dep" ,dep1)))))
|
|
|
|
|
|
(rewrite (package-input-rewriting/spec
|
|
|
|
|
|
`(("coreutils" . ,(const sed)))))
|
|
|
|
|
|
(p1 (rewrite p0)))
|
|
|
|
|
|
(match (package-inputs p1)
|
|
|
|
|
|
((("dep" dep))
|
|
|
|
|
|
(match (package-inputs (package-replacement dep))
|
|
|
|
|
|
((("coreutils" coreutils))
|
|
|
|
|
|
;; COREUTILS is not 'eq?' to SED, so the most reliable way to check
|
|
|
|
|
|
;; for equality is to lower to a derivation.
|
|
|
|
|
|
(derivation-file-name
|
|
|
|
|
|
(package-derivation %store coreutils))))))))
|
|
|
|
|
|
|
2020-09-28 15:36:42 +00:00
|
|
|
|
(test-assert "package-with-c-toolchain"
|
|
|
|
|
|
(let* ((dep (dummy-package "chbouib"
|
|
|
|
|
|
(build-system gnu-build-system)
|
|
|
|
|
|
(native-inputs `(("x" ,grep)))))
|
|
|
|
|
|
(p0 (dummy-package "thingie"
|
|
|
|
|
|
(build-system gnu-build-system)
|
|
|
|
|
|
(inputs `(("foo" ,grep)
|
|
|
|
|
|
("bar" ,dep)))))
|
|
|
|
|
|
(tc (dummy-package "my-toolchain"))
|
|
|
|
|
|
(p1 (package-with-c-toolchain p0 `(("toolchain" ,tc)))))
|
|
|
|
|
|
(define toolchain-packages
|
|
|
|
|
|
'("gcc" "binutils" "glibc" "ld-wrapper"))
|
|
|
|
|
|
|
|
|
|
|
|
(match (bag-build-inputs (package->bag p1))
|
|
|
|
|
|
((("foo" foo) ("bar" bar) (_ (= package-name packages) . _) ...)
|
|
|
|
|
|
(and (not (any (cut member <> packages) toolchain-packages))
|
|
|
|
|
|
(member "my-toolchain" packages)
|
|
|
|
|
|
(eq? foo grep)
|
|
|
|
|
|
(eq? bar dep))))))
|
|
|
|
|
|
|
2020-10-20 07:18:07 +00:00
|
|
|
|
(test-assert "package-input-rewriting/spec, identity"
|
|
|
|
|
|
;; Make sure that 'package-input-rewriting/spec' doesn't gratuitously
|
|
|
|
|
|
;; introduce variants. In this case, the LIBFFI propagated input should not
|
|
|
|
|
|
;; be duplicated when passing GOBJECT through REWRITE.
|
|
|
|
|
|
;; See <https://issues.guix.gnu.org/43890>.
|
|
|
|
|
|
(let* ((libffi (dummy-package "libffi"
|
|
|
|
|
|
(build-system trivial-build-system)))
|
|
|
|
|
|
(glib (dummy-package "glib"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(propagated-inputs `(("libffi" ,libffi)))))
|
|
|
|
|
|
(gobject (dummy-package "gobject-introspection"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(inputs `(("glib" ,glib)))
|
|
|
|
|
|
(propagated-inputs `(("libffi" ,libffi)))))
|
|
|
|
|
|
(rewrite (package-input-rewriting/spec
|
|
|
|
|
|
`(("glib" . ,identity)))))
|
|
|
|
|
|
(and (= (length (package-transitive-inputs gobject))
|
|
|
|
|
|
(length (package-transitive-inputs (rewrite gobject))))
|
|
|
|
|
|
(string=? (derivation-file-name
|
|
|
|
|
|
(package-derivation %store (rewrite gobject)))
|
|
|
|
|
|
(derivation-file-name
|
|
|
|
|
|
(package-derivation %store gobject))))))
|
|
|
|
|
|
|
|
|
|
|
|
(test-assert "package-input-rewriting, identity"
|
|
|
|
|
|
;; Similar to the test above, but with 'package-input-rewriting'.
|
|
|
|
|
|
;; See <https://issues.guix.gnu.org/43890>.
|
|
|
|
|
|
(let* ((libffi (dummy-package "libffi"
|
|
|
|
|
|
(build-system trivial-build-system)))
|
|
|
|
|
|
(glib (dummy-package "glib"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(propagated-inputs `(("libffi" ,libffi)))))
|
|
|
|
|
|
(gobject (dummy-package "gobject-introspection"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(inputs `(("glib" ,glib)))
|
|
|
|
|
|
(propagated-inputs `(("libffi" ,libffi)))))
|
|
|
|
|
|
(rewrite (package-input-rewriting `((,glib . ,glib)))))
|
|
|
|
|
|
(and (= (length (package-transitive-inputs gobject))
|
|
|
|
|
|
(length (package-transitive-inputs (rewrite gobject))))
|
|
|
|
|
|
(string=? (derivation-file-name
|
|
|
|
|
|
(package-derivation %store (rewrite gobject)))
|
|
|
|
|
|
(derivation-file-name
|
|
|
|
|
|
(package-derivation %store gobject))))))
|
|
|
|
|
|
|
2018-05-13 16:46:13 +00:00
|
|
|
|
(test-equal "package-patched-vulnerabilities"
|
|
|
|
|
|
'(("CVE-2015-1234")
|
|
|
|
|
|
("CVE-2016-1234" "CVE-2018-4567")
|
|
|
|
|
|
())
|
|
|
|
|
|
(let ((p1 (dummy-package "pi"
|
|
|
|
|
|
(source (dummy-origin
|
|
|
|
|
|
(patches (list "/a/b/pi-CVE-2015-1234.patch"))))))
|
|
|
|
|
|
(p2 (dummy-package "pi"
|
|
|
|
|
|
(source (dummy-origin
|
|
|
|
|
|
(patches (list
|
|
|
|
|
|
"/a/b/pi-CVE-2016-1234-CVE-2018-4567.patch"))))))
|
|
|
|
|
|
(p3 (dummy-package "pi" (source (dummy-origin)))))
|
|
|
|
|
|
(map package-patched-vulnerabilities
|
|
|
|
|
|
(list p1 p2 p3))))
|
|
|
|
|
|
|
2012-11-19 21:37:50 +00:00
|
|
|
|
(test-eq "fold-packages" hello
|
|
|
|
|
|
(fold-packages (lambda (p r)
|
|
|
|
|
|
(if (string=? (package-name p) "hello")
|
|
|
|
|
|
p
|
|
|
|
|
|
r))
|
|
|
|
|
|
#f))
|
|
|
|
|
|
|
2016-07-28 16:53:13 +00:00
|
|
|
|
(test-assert "fold-packages, hidden package"
|
|
|
|
|
|
;; There are two public variables providing "guile@2.0" ('guile-final' in
|
2016-11-08 22:31:36 +00:00
|
|
|
|
;; commencement.scm and 'guile-2.0' in guile.scm), but only the latter
|
2016-07-28 16:53:13 +00:00
|
|
|
|
;; should show up.
|
|
|
|
|
|
(match (fold-packages (lambda (p r)
|
|
|
|
|
|
(if (and (string=? (package-name p) "guile")
|
|
|
|
|
|
(string-prefix? "2.0"
|
|
|
|
|
|
(package-version p)))
|
|
|
|
|
|
(cons p r)
|
|
|
|
|
|
r))
|
|
|
|
|
|
'())
|
|
|
|
|
|
((one)
|
2016-11-08 22:31:36 +00:00
|
|
|
|
(eq? one guile-2.0))))
|
2016-07-28 16:53:13 +00:00
|
|
|
|
|
2019-01-13 14:36:49 +00:00
|
|
|
|
(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))
|
|
|
|
|
|
'()))))))
|
|
|
|
|
|
|
2021-02-01 15:07:18 +00:00
|
|
|
|
(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)))))
|
2019-01-13 14:36:49 +00:00
|
|
|
|
|
2012-06-30 14:37:19 +00:00
|
|
|
|
(test-assert "find-packages-by-name"
|
|
|
|
|
|
(match (find-packages-by-name "hello")
|
|
|
|
|
|
(((? (cut eq? hello <>))) #t)
|
|
|
|
|
|
(wrong (pk 'find-packages-by-name wrong #f))))
|
|
|
|
|
|
|
|
|
|
|
|
(test-assert "find-packages-by-name with version"
|
|
|
|
|
|
(match (find-packages-by-name "hello" (package-version hello))
|
|
|
|
|
|
(((? (cut eq? hello <>))) #t)
|
|
|
|
|
|
(wrong (pk 'find-packages-by-name wrong #f))))
|
|
|
|
|
|
|
2019-01-11 16:23:39 +00:00
|
|
|
|
(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"))))))
|
|
|
|
|
|
|
2015-01-03 18:46:07 +00:00
|
|
|
|
(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
|
|
|
|
|
|
;; symlinks when looking for 'catalog.xml'.) To do that, we rely on the
|
|
|
|
|
|
;; libxml2 package specification, which contains such a definition.
|
|
|
|
|
|
(let* ((p1 (package
|
|
|
|
|
|
(name "foo") (version "0") (source #f)
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
|
|
|
|
|
#:modules ((guix build utils))
|
|
|
|
|
|
#:builder (begin
|
|
|
|
|
|
(use-modules (guix build utils))
|
|
|
|
|
|
(let ((out (assoc-ref %outputs "out")))
|
|
|
|
|
|
(mkdir-p (string-append out "/xml/bar/baz"))
|
|
|
|
|
|
(call-with-output-file
|
|
|
|
|
|
(string-append out "/xml/bar/baz/catalog.xml")
|
|
|
|
|
|
(lambda (port)
|
2018-03-28 00:05:58 +00:00
|
|
|
|
(display "xml? wat?!" port)))
|
|
|
|
|
|
#t))))
|
2015-01-03 18:46:07 +00:00
|
|
|
|
(synopsis #f) (description #f)
|
|
|
|
|
|
(home-page #f) (license #f)))
|
|
|
|
|
|
(p2 (package
|
|
|
|
|
|
;; Provide a fake libxml2 to avoid building the real one. This
|
|
|
|
|
|
;; is OK because 'guix package' gets search path specifications
|
|
|
|
|
|
;; from the same-named package found in the distro.
|
|
|
|
|
|
(name "libxml2") (version "0.0.0") (source #f)
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
2018-03-28 00:05:58 +00:00
|
|
|
|
#:builder (begin
|
|
|
|
|
|
(mkdir (assoc-ref %outputs "out"))
|
|
|
|
|
|
#t)))
|
2015-01-03 18:46:07 +00:00
|
|
|
|
(native-search-paths (package-native-search-paths libxml2))
|
|
|
|
|
|
(synopsis #f) (description #f)
|
|
|
|
|
|
(home-page #f) (license #f)))
|
|
|
|
|
|
(prof (run-with-store %store
|
|
|
|
|
|
(profile-derivation
|
|
|
|
|
|
(manifest (map package->manifest-entry
|
|
|
|
|
|
(list p1 p2)))
|
2016-12-17 11:43:10 +00:00
|
|
|
|
#:hooks '()
|
|
|
|
|
|
#:locales? #f)
|
2015-01-03 18:46:07 +00:00
|
|
|
|
#:guile-for-build (%guile-for-build))))
|
|
|
|
|
|
(build-derivations %store (list prof))
|
|
|
|
|
|
(string-match (format #f "^export XML_CATALOG_FILES=\"~a/xml/+bar/baz/catalog\\.xml\"\n"
|
2016-06-19 21:51:58 +00:00
|
|
|
|
(regexp-quote (derivation->output-path prof)))
|
2015-01-03 18:46:07 +00:00
|
|
|
|
(with-output-to-string
|
|
|
|
|
|
(lambda ()
|
|
|
|
|
|
(guix-package "-p" (derivation->output-path prof)
|
|
|
|
|
|
"--search-paths"))))))
|
|
|
|
|
|
|
2017-01-22 21:42:57 +00:00
|
|
|
|
(test-assert "--search-paths with single-item search path"
|
|
|
|
|
|
;; Make sure 'guix package --search-paths' correctly reports environment
|
|
|
|
|
|
;; variables for things like 'GIT_SSL_CAINFO' that have #f as their
|
|
|
|
|
|
;; separator, meaning that the first match wins.
|
|
|
|
|
|
(let* ((p1 (dummy-package "foo"
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
|
|
|
|
|
#:modules ((guix build utils))
|
|
|
|
|
|
#:builder (begin
|
|
|
|
|
|
(use-modules (guix build utils))
|
|
|
|
|
|
(let ((out (assoc-ref %outputs "out")))
|
|
|
|
|
|
(mkdir-p (string-append out "/etc/ssl/certs"))
|
|
|
|
|
|
(call-with-output-file
|
|
|
|
|
|
(string-append
|
|
|
|
|
|
out "/etc/ssl/certs/ca-certificates.crt")
|
|
|
|
|
|
(const #t))))))))
|
|
|
|
|
|
(p2 (package (inherit p1) (name "bar")))
|
|
|
|
|
|
(p3 (dummy-package "git"
|
|
|
|
|
|
;; Provide a fake Git to avoid building the real one.
|
|
|
|
|
|
(build-system trivial-build-system)
|
|
|
|
|
|
(arguments
|
|
|
|
|
|
`(#:guile ,%bootstrap-guile
|
2018-03-28 00:05:58 +00:00
|
|
|
|
#:builder (begin
|
|
|
|
|
|
(mkdir (assoc-ref %outputs "out"))
|
|
|
|
|
|
#t)))
|
2017-01-22 21:42:57 +00:00
|
|
|
|
(native-search-paths (package-native-search-paths git))))
|
|
|
|
|
|
(prof1 (run-with-store %store
|
|
|
|
|
|
(profile-derivation
|
|
|
|
|
|
(packages->manifest (list p1 p3))
|
|
|
|
|
|
#:hooks '()
|
|
|
|
|
|
#:locales? #f)
|
|
|
|
|
|
#:guile-for-build (%guile-for-build)))
|
|
|
|
|
|
(prof2 (run-with-store %store
|
|
|
|
|
|
(profile-derivation
|
|
|
|
|
|
(packages->manifest (list p2 p3))
|
|
|
|
|
|
#:hooks '()
|
|
|
|
|
|
#:locales? #f)
|
|
|
|
|
|
#:guile-for-build (%guile-for-build))))
|
|
|
|
|
|
(build-derivations %store (list prof1 prof2))
|
|
|
|
|
|
(string-match (format #f "^export GIT_SSL_CAINFO=\"~a/etc/ssl/certs/ca-certificates.crt"
|
|
|
|
|
|
(regexp-quote (derivation->output-path prof1)))
|
|
|
|
|
|
(with-output-to-string
|
|
|
|
|
|
(lambda ()
|
|
|
|
|
|
(guix-package "-p" (derivation->output-path prof1)
|
|
|
|
|
|
"-p" (derivation->output-path prof2)
|
|
|
|
|
|
"--search-paths"))))))
|
|
|
|
|
|
|
2016-03-08 10:48:21 +00:00
|
|
|
|
(test-equal "specification->package when not found"
|
|
|
|
|
|
'quit
|
|
|
|
|
|
(catch 'quit
|
|
|
|
|
|
(lambda ()
|
|
|
|
|
|
;; This should call 'leave', producing an error message.
|
|
|
|
|
|
(specification->package "this-package-does-not-exist"))
|
|
|
|
|
|
(lambda (key . args)
|
|
|
|
|
|
key)))
|
|
|
|
|
|
|
2019-06-23 16:28:45 +00:00
|
|
|
|
(test-equal "specification->package+output"
|
|
|
|
|
|
`((,coreutils "out") (,coreutils "debug"))
|
|
|
|
|
|
(list (call-with-values (lambda ()
|
|
|
|
|
|
(specification->package+output "coreutils"))
|
|
|
|
|
|
list)
|
|
|
|
|
|
(call-with-values (lambda ()
|
|
|
|
|
|
(specification->package+output "coreutils:debug"))
|
|
|
|
|
|
list)))
|
|
|
|
|
|
|
|
|
|
|
|
(test-equal "specification->package+output invalid output"
|
|
|
|
|
|
'error
|
|
|
|
|
|
(catch 'quit
|
|
|
|
|
|
(lambda ()
|
|
|
|
|
|
(specification->package+output "coreutils:does-not-exist"))
|
|
|
|
|
|
(lambda _
|
|
|
|
|
|
'error)))
|
|
|
|
|
|
|
|
|
|
|
|
(test-equal "specification->package+output no default output"
|
|
|
|
|
|
`(,coreutils #f)
|
|
|
|
|
|
(call-with-values
|
|
|
|
|
|
(lambda ()
|
|
|
|
|
|
(specification->package+output "coreutils" #f))
|
|
|
|
|
|
list))
|
|
|
|
|
|
|
|
|
|
|
|
(test-equal "specification->package+output invalid output, no default"
|
|
|
|
|
|
'error
|
|
|
|
|
|
(catch 'quit
|
|
|
|
|
|
(lambda ()
|
|
|
|
|
|
(specification->package+output "coreutils:does-not-exist" #f))
|
|
|
|
|
|
(lambda _
|
|
|
|
|
|
'error)))
|
|
|
|
|
|
|
2019-01-13 13:27:10 +00:00
|
|
|
|
(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"))
|
|
|
|
|
|
|
2012-06-27 23:24:34 +00:00
|
|
|
|
(test-end "packages")
|
|
|
|
|
|
|
|
|
|
|
|
;;; Local Variables:
|
2012-07-07 18:14:20 +00:00
|
|
|
|
;;; eval: (put 'dummy-package 'scheme-indent-function 1)
|
2019-01-25 09:05:31 +00:00
|
|
|
|
;;; eval: (put 'dummy-package/no-implicit 'scheme-indent-function 1)
|
2012-06-27 23:24:34 +00:00
|
|
|
|
;;; End:
|
