~ruther/guix-local

bbceb0ef8a1e05faaa15c5b4135275fb4572b8d9 — Ludovic Courtès 11 years ago 42f1180
packages: Add 'supported-package?'.

* guix/packages.scm (supported-package?): New procedure.
* tests/packages.scm ("supported-package?"): New test.
* build-aux/hydra/gnu-system.scm (package->job): Use it instead of
  'package-transitive-supported-systems'.
3 files changed, 15 insertions(+), 2 deletions(-)

M build-aux/hydra/gnu-system.scm
M guix/packages.scm
M tests/packages.scm
M build-aux/hydra/gnu-system.scm => build-aux/hydra/gnu-system.scm +1 -2
@@ 204,8 204,7 @@ all its dependencies, and ready to be installed on non-GuixSD distributions.")
valid."
      (cond ((member package base-packages)
             #f)
            ((member system
                     (package-transitive-supported-systems package))
            ((supported-package? package system)
             (package-job store (job-name package) package system))
            (else
             #f)))))

M guix/packages.scm => guix/packages.scm +6 -0
@@ 95,6 95,7 @@
            package-grafts

            %supported-systems
            supported-package?

            &package-error
            package-error?


@@ 581,6 582,11 @@ supported by its dependencies."
        (package-supported-systems package)
        (bag-direct-inputs (package->bag package))))

(define* (supported-package? package #:optional (system (%current-system)))
  "Return true if PACKAGE is supported on SYSTEM--i.e., if PACKAGE and all its
dependencies are known to build on SYSTEM."
  (member system (package-transitive-supported-systems package)))

(define (bag-direct-inputs bag)
  "Same as 'package-direct-inputs', but applied to a bag."
  (append (bag-build-inputs bag)

M tests/packages.scm => tests/packages.scm +8 -0
@@ 166,6 166,14 @@
              `("does-not-exist" "foobar" ,@%supported-systems)))))
    (package-transitive-supported-systems p)))

(test-assert "supported-package?"
  (let ((p (dummy-package "foo"
             (build-system gnu-build-system)
             (supported-systems '("x86_64-linux" "does-not-exist")))))
    (and (supported-package? p "x86_64-linux")
         (not (supported-package? p "does-not-exist"))
         (not (supported-package? p "i686-linux")))))

(test-skip (if (not %store) 8 0))

(test-assert "package-source-derivation, file"