~ruther/guix-local

9bf3ced06c42700d6c83ce3a0eda244798104618 — Ludovic Courtès 11 years ago cceab87
packages: 'package-transitive-supported-systems' accounts for implicit inputs.

Reported by Federico Beffa.

* guix/packages.scm (package-transitive-supported-systems): Use
  bag-direct-inputs + package->bag rather than package-direct-inputs.
* tests/packages.scm ("package-transitive-supported-systems"): Add
  explicit 'build-system' field to each 'dummy-package' form.
  ("package-transitive-supported-systems, implicit inputs"): New test.
2 files changed, 33 insertions(+), 10 deletions(-)

M guix/packages.scm
M tests/packages.scm
M guix/packages.scm => guix/packages.scm +1 -1
@@ 579,7 579,7 @@ supported by its dependencies."
            (_
             systems)))
        (package-supported-systems package)
        (package-direct-inputs package)))
        (bag-direct-inputs (package->bag package))))

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

M tests/packages.scm => tests/packages.scm +32 -9
@@ 128,21 128,44 @@
    ("y")                                         ;c
    ("y")                                         ;d
    ("y"))                                        ;e
  (let* ((a (dummy-package "a" (supported-systems '("x" "y" "z"))))
         (b (dummy-package "b" (supported-systems '("x" "y"))
               (inputs `(("a" ,a)))))
         (c (dummy-package "c" (supported-systems '("y" "z"))
               (inputs `(("b" ,b)))))
         (d (dummy-package "d" (supported-systems '("x" "y" "z"))
               (inputs `(("b" ,b) ("c" ,c)))))
         (e (dummy-package "e" (supported-systems '("x" "y" "z"))
               (inputs `(("d" ,d))))))
  ;; 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))))))
    (list (package-transitive-supported-systems a)
          (package-transitive-supported-systems b)
          (package-transitive-supported-systems c)
          (package-transitive-supported-systems d)
          (package-transitive-supported-systems e))))

(test-equal "package-transitive-supported-systems, implicit inputs"
  %supported-systems

  ;; 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)))))
    (package-transitive-supported-systems p)))

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

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