ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
Fixes a regression introduced in
560cb51e7b, 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.
This commit is contained in:
Ludovic Courtès 2023-08-21 15:13:59 +02:00
parent 9c34b793c1
commit df2117b8e0
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 15 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
tests/graph.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -377,7 +377,8 @@ (define (edge->tuple source target)
(((labels packages _ ...) ...) (((labels packages _ ...) ...)
packages))))))))) packages)))))))))
(test-assert "node-transitive-edges + node-back-edges" (test-equal "node-transitive-edges + node-back-edges"
'()
(run-with-store %store (run-with-store %store
(let ((packages (fold-packages cons '())) (let ((packages (fold-packages cons '()))
(bootstrap? (lambda (package) (bootstrap? (lambda (package)
@ -386,17 +387,22 @@ (define (edge->tuple source target)
"bootstrap.scm"))) "bootstrap.scm")))
(trivial? (lambda (package) (trivial? (lambda (package)
(eq? (package-build-system 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))) (mlet %store-monad ((edges (node-back-edges %bag-node-type packages)))
(let* ((glibc (canonical-package glibc)) (let* ((glibc (canonical-package glibc))
(dependents (node-transitive-edges (list glibc) edges)) (dependents (node-transitive-edges (list glibc) edges))
(diff (lset-difference eq? packages dependents))) (diff (lset-difference eq? packages dependents)))
;; All the packages depend on libc, except bootstrap packages and ;; All the packages depend on libc, except bootstrap packages, some
;; some that use TRIVIAL-BUILD-SYSTEM. ;; packages that use TRIVIAL-BUILD-SYSTEM, and some that target a
(return (null? (remove (lambda (package) ;; specific system and thus may depend on a different libc package
(or (trivial? package) ;; object.
(bootstrap? package))) (return (remove (lambda (package)
diff)))))))) (or (trivial? package)
(bootstrap? package)
(system-specific? package)))
diff)))))))
(test-assert "node-transitive-edges, no duplicates" (test-assert "node-transitive-edges, no duplicates"
(run-with-store %store (run-with-store %store