packages: Ensure bags are insensitive to '%current-system'.

Fixes <https://bugs.gnu.org/42327>.
Reported by Jan Nieuwenhuizen <janneke@gnu.org>.

This is a followup to f52fbf7094.

* guix/packages.scm (bag-transitive-inputs, bag-transitive-build-inputs)
(bag-transitive-host-inputs, bag-transitive-target-inputs): Parameterize
%CURRENT-SYSTEM in addition to %CURRENT-TARGET-SYSTEM.
* tests/packages.scm ("package->bag, sensitivity to %current-system"):
New test.
This commit is contained in:
Ludovic Courtès 2020-07-13 16:43:58 +02:00
parent 399d89b5c8
commit efb10f175f
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 22 additions and 4 deletions

View file

@ -923,22 +923,26 @@ (define (bag-direct-inputs bag)
(define (bag-transitive-inputs bag) (define (bag-transitive-inputs bag)
"Same as 'package-transitive-inputs', but applied to a bag." "Same as 'package-transitive-inputs', but applied to a bag."
(parameterize ((%current-target-system #f)) (parameterize ((%current-target-system #f)
(%current-system (bag-system bag)))
(transitive-inputs (bag-direct-inputs bag)))) (transitive-inputs (bag-direct-inputs bag))))
(define (bag-transitive-build-inputs bag) (define (bag-transitive-build-inputs bag)
"Same as 'package-transitive-native-inputs', but applied to a bag." "Same as 'package-transitive-native-inputs', but applied to a bag."
(parameterize ((%current-target-system #f)) (parameterize ((%current-target-system #f)
(%current-system (bag-system bag)))
(transitive-inputs (bag-build-inputs bag)))) (transitive-inputs (bag-build-inputs bag))))
(define (bag-transitive-host-inputs bag) (define (bag-transitive-host-inputs bag)
"Same as 'package-transitive-target-inputs', but applied to a bag." "Same as 'package-transitive-target-inputs', but applied to a bag."
(parameterize ((%current-target-system (bag-target bag))) (parameterize ((%current-target-system (bag-target bag))
(%current-system (bag-system bag)))
(transitive-inputs (bag-host-inputs bag)))) (transitive-inputs (bag-host-inputs bag))))
(define (bag-transitive-target-inputs bag) (define (bag-transitive-target-inputs bag)
"Return the \"target inputs\" of BAG, recursively." "Return the \"target inputs\" of BAG, recursively."
(parameterize ((%current-target-system (bag-target bag))) (parameterize ((%current-target-system (bag-target bag))
(%current-system (bag-system bag)))
(transitive-inputs (bag-target-inputs bag)))) (transitive-inputs (bag-target-inputs bag))))
(define* (package-closure packages #:key (system (%current-system))) (define* (package-closure packages #:key (system (%current-system)))

View file

@ -1110,6 +1110,20 @@ (define read-at
(("dep" package) (("dep" package)
(eq? package dep))))) (eq? package dep)))))
(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)))))
(test-assert "package->bag, sensitivity to %current-target-system" (test-assert "package->bag, sensitivity to %current-target-system"
(let* ((dep (dummy-package "dep" (let* ((dep (dummy-package "dep"
(propagated-inputs (if (%current-target-system) (propagated-inputs (if (%current-target-system)