02/05: tests: Adjust 'node-back-edges' test for 'bag' to system-dependent glibc.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit df2117b8e0e9a35ef8be7f122a783190cafed669
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Aug 21 15:13:59 2023 +0200

    tests: Adjust 'node-back-edges' test for 'bag' to system-dependent glibc.
    
    Fixes a regression introduced in
    560cb51e7b37e2c6f6fe4b72a3781185c57fdf83, which would lead this test on
    x86_64-linux to return a DIFF with two packages, nhc98 and dev86 (both
    have #:system "i686-linux" and thus depend on a different glibc object;
    why other system-specific packages such as 'wine' aren't reported is
    unclear).
    
    * tests/graph.scm ("node-transitive-edges + node-back-edges"): Use
    'test-equal'.  Define 'system-specific?' and use it.
---
 tests/graph.scm | 24 +++++++++++++++---------
 1 file changed, 15 insertions(+), 9 deletions(-)

diff --git a/tests/graph.scm b/tests/graph.scm
index a6186ff7e8..c8189366a1 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015-2023 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -377,7 +377,8 @@ edges."
                               (((labels packages _ ...) ...)
                                packages)))))))))
 
-(test-assert "node-transitive-edges + node-back-edges"
+(test-equal "node-transitive-edges + node-back-edges"
+  '()
   (run-with-store %store
     (let ((packages   (fold-packages cons '()))
           (bootstrap? (lambda (package)
@@ -386,17 +387,22 @@ edges."
                          "bootstrap.scm")))
           (trivial?   (lambda (package)
                         (eq? (package-build-system package)
-                             trivial-build-system))))
+                             trivial-build-system)))
+          (system-specific? (lambda (package)
+                              (memq #:system (package-arguments package)))))
       (mlet %store-monad ((edges (node-back-edges %bag-node-type packages)))
         (let* ((glibc      (canonical-package glibc))
                (dependents (node-transitive-edges (list glibc) edges))
                (diff       (lset-difference eq? packages dependents)))
-          ;; All the packages depend on libc, except bootstrap packages and
-          ;; some that use TRIVIAL-BUILD-SYSTEM.
-          (return (null? (remove (lambda (package)
-                                   (or (trivial? package)
-                                       (bootstrap? package)))
-                                 diff))))))))
+          ;; All the packages depend on libc, except bootstrap packages, some
+          ;; packages that use TRIVIAL-BUILD-SYSTEM, and some that target a
+          ;; specific system and thus may depend on a different libc package
+          ;; object.
+          (return (remove (lambda (package)
+                            (or (trivial? package)
+                                (bootstrap? package)
+                                (system-specific? package)))
+                          diff)))))))
 
 (test-assert "node-transitive-edges, no duplicates"
   (run-with-store %store