GNU bug report logs - #63917
[PATCH] packages: 'package-transitive-supported-systems' detects cycles.

Previous Next

Full log

View this message in rfc822 format

From: Ludovic Courtès <ludo <at> gnu.org>
To: 63917 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>, Christopher Baines <mail <at> cbaines.net>, Josselin Poiret <dev <at> jpoiret.xyz>, Ludovic Courtès <ludo <at> gnu.org>, Mathieu Othacehe <othacehe <at> gnu.org>, Ricardo Wurmus <rekado <at> elephly.net>, Simon Tournier <zimon.toutoune <at> gmail.com>, Tobias Geerinckx-Rice <me <at> tobias.gr>
Subject: [bug#63917] [PATCH] packages: 'package-transitive-supported-systems' detects cycles.
Date: Mon,  5 Jun 2023 23:56:09 +0200

With this change, commands such as 'guix build' or 'guix package' report
obvious package-level cycles upfront.  Derivation-level cycles are not
detected.

* guix/packages.scm (&package-cyclic-dependency-error): New condition
type.
(package-transitive-supported-systems): Define 'visited', check it, and
parameterize it.
* guix/ui.scm (call-with-error-handling): Handle
'&package-cyclic-dependency-error'.
* tests/packages.scm ("package-transitive-supported-systems detects
cycles"): Add test.
---
 guix/packages.scm  | 41 ++++++++++++++++++++++++++++++-----------
 guix/ui.scm        |  9 +++++++++
 tests/packages.scm | 17 +++++++++++++++++
 3 files changed, 56 insertions(+), 11 deletions(-)

Hi!

At long last!  This is a pretty basic cycle detection trick: it can only
detect package-level cycles and not more subtle things like that
in <https://issues.guix.gnu.org/63331>, but it’s also less expensive and
intrusive than something right into ‘package->derivation’.

Bonus: since ‘package-transitive-supported-systems’ is used when building
‘guix-package-cache.drv’, it would fail right during ‘guix pull’ instead
of eating up all the memory, as in <https://issues.guix.gnu.org/63852>.

Thoughts?

Ludo’.

diff --git a/guix/packages.scm b/guix/packages.scm
index e26602d589..ba98bb0fb4 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -168,6 +168,9 @@ (define-module (guix packages)
             package-error-invalid-license
             &package-input-error
             package-input-error?
+            &package-cyclic-dependency-error
+            package-cyclic-dependency-error?
+            package-error-dependency-cycle
             package-error-invalid-input
             &package-cross-build-system-error
             package-cross-build-system-error?
@@ -806,6 +809,10 @@ (define-condition-type &package-input-error &package-error
   package-input-error?
   (input package-error-invalid-input))
 
+(define-condition-type &package-cyclic-dependency-error &package-error
+  package-cyclic-dependency-error?
+  (cycle package-error-dependency-cycle))
+
 (define-condition-type &package-cross-build-system-error &package-error
   package-cross-build-system-error?)
 
@@ -1317,17 +1324,29 @@ (define package-transitive-supported-systems
   (let ()
     (define (supported-systems-procedure system)
       (define supported-systems
-        (mlambdaq (package)
-          (parameterize ((%current-system system))
-            (fold (lambda (input systems)
-                    (match input
-                      ((label (? package? package) . _)
-                       (lset-intersection string=? systems
-                                          (supported-systems package)))
-                      (_
-                       systems)))
-                  (package-supported-systems package)
-                  (bag-direct-inputs (package->bag package system #f))))))
+        ;; The VISITED parameter allows for cycle detection.  This is a pretty
+        ;; strategic place to do that: most commands call it upfront, yet it's
+        ;; not on the hot path of 'package->derivation'.  The downside is that
+        ;; only package-level cycles are detected.
+        (let ((visited (make-parameter (setq))))
+          (mlambdaq (package)
+            (when (set-contains? (visited) package)
+              (raise (condition
+                      (&package-cyclic-dependency-error
+                       (package package)
+                       (cycle (set->list (visited)))))))
+
+            (parameterize ((visited (set-insert package (visited)))
+                           (%current-system system))
+              (fold (lambda (input systems)
+                      (match input
+                        ((label (? package? package) . _)
+                         (lset-intersection string=? systems
+                                            (supported-systems package)))
+                        (_
+                         systems)))
+                    (package-supported-systems package)
+                    (bag-direct-inputs (package->bag package system #f)))))))
 
       supported-systems)
 
diff --git a/guix/ui.scm b/guix/ui.scm
index 7540e2194f..47a118364a 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -722,6 +722,15 @@ (define (call-with-error-handling thunk)
                 (leave (G_ "~a:~a:~a: package `~a' has an invalid input: ~s~%")
                        file line column
                        (package-full-name package) input)))
+             ((package-cyclic-dependency-error? c)
+              (let ((package (package-error-package c)))
+                (leave (package-location package)
+                       (G_ "~a: dependency cycle detected:
+  ~a~{ -> ~a~}~%")
+                       (package-full-name package)
+                       (package-full-name package)
+                       (map package-full-name
+                            (package-error-dependency-cycle c)))))
              ((package-cross-build-system-error? c)
               (let* ((package (package-error-package c))
                      (loc     (package-location package))
diff --git a/tests/packages.scm b/tests/packages.scm
index 5e8eac99dc..2b7ab01f7d 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -368,6 +368,23 @@ (define %store
           (package-transitive-supported-systems d)
           (package-transitive-supported-systems e))))
 
+(test-equal "package-transitive-supported-systems detects cycles"
+  '("c" "a" "b" "c")
+  (letrec* ((a (dummy-package "a"
+                 (build-system trivial-build-system)
+                 (native-inputs (list c))))
+            (b (dummy-package "b"
+                 (build-system trivial-build-system)
+                 (inputs (list a))))
+            (c (dummy-package "c"
+                 (build-system trivial-build-system)
+                 (inputs (list b)))))
+    (guard (c ((package-cyclic-dependency-error? c)
+               (map package-name
+                    (cons (package-error-package c)
+                          (package-error-dependency-cycle c)))))
+      (package-transitive-supported-systems c))))
+
 (test-assert "package-development-inputs"
   ;; Note: Due to propagated inputs, 'package-development-inputs' returns a
   ;; couple more inputs, such as 'linux-libre-headers'.

base-commit: 940665301de4effd065d24c167f619286f2adf4c
-- 
2.40.1

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.