branch master updated: Change how package supported systems are handled

[Christopher Baines]

This is an automated email from the git hooks/post-receive script.

cbaines pushed a commit to branch master
in repository data-service.

The following commit(s) were added to refs/heads/master by this push:
     new 17167ef  Change how package supported systems are handled
17167ef is described below

commit 17167ef3e445cdf880f9d9862e7bfc07552bd86f
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Fri Feb 18 12:21:08 2022 +0000

    Change how package supported systems are handled
    
    This code is a bit tricky, since it should be compatible with old and new 
guix
    revisions. I think these changes stop computing package derivations for
    invalid systems, while hopefully not breaking anything.
---
 guix-data-service/jobs/load-new-guix-revision.scm | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm 
b/guix-data-service/jobs/load-new-guix-revision.scm
index bd4c3b4..8a7e5aa 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -588,7 +588,6 @@ WHERE job_id = $1")
            ("riscv64-linux-gnu" . "")   ; TODO I don't know?
            ("i586-pc-gnu" . "i586-gnu")))
 
-       ;; TODO Currently unused
        (define 
package-transitive-supported-systems-supports-multiple-arguments? #t)
        (define (get-supported-systems package system)
          (or (and 
package-transitive-supported-systems-supports-multiple-arguments?
@@ -602,17 +601,17 @@ WHERE job_id = $1")
                       ;; package-transitive-supported-systems
                       (simple-format
                        (current-error-port)
-                       "info: package-transitive-supported-systems doesn't 
support two arguments, falling back to one\n")
+                       "info: package-transitive-supported-systems doesn't 
support two arguments, falling back to package-supported-systems\n")
                       (set! 
package-transitive-supported-systems-supports-multiple-arguments? #f)
                       #f)))
              (catch
                #t
                (lambda ()
-                 (package-transitive-supported-systems package))
+                 (package-supported-systems package))
                (lambda (key . args)
                  (simple-format
                   (current-error-port)
-                  "error: while processing ~A, unable to compute transitive 
supported systems\n"
+                  "error: while processing ~A, unable to compute supported 
systems\n"
                   (package-name package))
                  (simple-format
                   (current-error-port)
@@ -662,8 +661,9 @@ WHERE job_id = $1")
               (lambda ()
                 (append-map
                  (lambda (system)
-                   (let ((supported-systems (package-supported-systems 
package)))
-                     (if supported-systems
+                   (let ((supported-systems (get-supported-systems package 
system)))
+                     (if (and supported-systems
+                              (member system supported-systems))
                          (filter-map
                           (lambda (target)
                             (derivations-for-system-and-target 
inferior-package-id
@@ -678,7 +678,7 @@ WHERE job_id = $1")
                                      (assoc-ref target-system-alist
                                                 target)))
                                 (member system-for-target
-                                        supported-systems
+                                        (package-supported-systems package)
                                         string=?))))
                            (list ,@(map cdr system-target-pairs))))
                          '())))