02/12: packages: 'package-transitive-supported-systems' ignores '%current-target-system'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 0572737a6218d7390bac352011da47621e18d35b
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Feb 17 16:04:15 2022 +0100

    packages: 'package-transitive-supported-systems' ignores 
'%current-target-system'.
    
    Previously 'package-transitive-supported-systems' would enter an
    infinite loop over the cross-compilation tool chain if
    %CURRENT-TARGET-SYSTEM was set.
    
    * guix/packages.scm 
(package-transitive-supported-systems)[supported-systems-procedure]:
    Pass explicit SYSTEM and TARGET parameters.
    * tests/packages.scm ("supported-package? vs. %current-target-system"):
    New test.
---
 guix/packages.scm  |  4 ++--
 tests/packages.scm | 10 ++++++++++
 2 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index 9d5b23eb8a..3f0262602d 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 
Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014, 2015, 2017, 2018, 2019 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
@@ -1235,7 +1235,7 @@ in INPUTS and their transitive propagated inputs."
                       (_
                        systems)))
                   (package-supported-systems package)
-                  (bag-direct-inputs (package->bag package))))))
+                  (bag-direct-inputs (package->bag package system #f))))))
 
       supported-systems)
 
diff --git a/tests/packages.scm b/tests/packages.scm
index 55b1c4064f..02bdba5f98 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -508,6 +508,16 @@
     (and (supported-package? p "x86_64-linux")
          (supported-package? p "armhf-linux"))))
 
+(test-assert "supported-package? vs. %current-target-system"
+  ;; The %CURRENT-TARGET-SYSTEM value should have no influence.
+  (parameterize ((%current-target-system "arm-linux-gnueabihf"))
+    (let ((p (dummy-package "foo"
+               (build-system gnu-build-system)
+               (supported-systems '("x86_64-linux" "armhf-linux")))))
+      (and (supported-package? p "x86_64-linux")
+           (not (supported-package? p "i686-linux"))
+           (supported-package? p "armhf-linux")))))
+
 (test-skip (if (not %store) 8 0))
 
 (test-assert "package-source-derivation, file"