diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/gnu-maintenance.scm | 48 | ||||
| -rw-r--r-- | tests/graph.scm | 24 | ||||
| -rw-r--r-- | tests/guix-home.sh | 2 | ||||
| -rw-r--r-- | tests/guix-shell.sh | 2 |
4 files changed, 64 insertions, 12 deletions
diff --git a/tests/gnu-maintenance.scm b/tests/gnu-maintenance.scm index 516e02ec6a..61ae295b96 100644 --- a/tests/gnu-maintenance.scm +++ b/tests/gnu-maintenance.scm @@ -40,7 +40,10 @@ ("exiv2" "exiv2-0.27.3-Source.tar.gz") ("mpg321" "mpg321_0.3.2.orig.tar.gz") ("bvi" "bvi-1.4.1.src.tar.gz") - ("hostscope" "hostscope-V2.1.tgz"))) + ("hostscope" "hostscope-V2.1.tgz") + ("qtbase" "qtbase-everywhere-src-6.5.2.tar.xz") + ("qtbase" "qtbase-everywhere-opensource-src-5.15.10.tar.xz") + ("qt-creator" "qt-creator-opensource-src-11.0.1.tar.xz"))) (every (lambda (project+file) (not (apply release-file? project+file))) '(("guile" "guile-www-1.1.1.tar.gz") @@ -147,4 +150,47 @@ (equal? (list expected-signature-url) (upstream-source-signature-urls update)))))) +(test-equal "rewrite-url, to-version specified" + "https://download.qt.io/official_releases/qt/6.5/6.5.2/\ +submodules/qtbase-everywhere-src-6.5.2.tar.xz" + (rewrite-url "https://download.qt.io/official_releases/qt/6.3/6.3.2/\ +submodules/qtbase-everywhere-src-6.3.2.tar.xz" "6.3.2" #:to-version "6.5.2")) + +(test-equal "rewrite-url, without to-version" + "https://dist.libuv.org/dist/v1.46.0/libuv-v1.46.0.tar.gz" + (with-http-server + ;; First reply, crawling https://dist.libuv.org/dist/. + `((200 "\ +<!DOCTYPE html> +<html> +<head><title>Index of dist</title></head> +<body> +<a href=\"../\">../</a> +<a href=\"v1.44.0/\" title=\"v1.44.0/\">v1.44.0/</a> +<a href=\"v1.44.1/\" title=\"v1.44.1/\">v1.44.1/</a> +<a href=\"v1.44.2/\" title=\"v1.44.2/\">v1.44.2/</a> +<a href=\"v1.45.0/\" title=\"v1.45.0/\">v1.45.0/</a> +<a href=\"v1.46.0/\" title=\"v1.46.0/\">v1.46.0/</a> +</body> +</html>") + ;; Second reply, crawling https://dist.libuv.org/dist/v1.46.0/. + (200 "\ +<!DOCTYPE html> +<html> +<head><title>Index of dist/v1.46.0</title></head> +<body> +<a href=\"../\">../</a> +<a href=\"libuv-v1.46.0-dist.tar.gz\" title=\"libuv-v1.46.0-dist.tar.gz\"> + libuv-v1.46.0-dist.tar.gz</a> +<a href=\"libuv-v1.46.0-dist.tar.gz.sign\" + title=\"libuv-v1.46.0-dist.tar.gz.sign\">libuv-v1.46.0-dist.tar.gz.sign</a> +<a href=\"libuv-v1.46.0.tar.gz\" title=\"libuv-v1.46.0.tar.gz\"> + libuv-v1.46.0.tar.gz</a> +<a href=\"libuv-v1.46.0.tar.gz.sign\" title=\"libuv-v1.46.0.tar.gz.sign\"> + libuv-v1.46.0.tar.gz.sign</a> +</body> +</html>")) + (rewrite-url "https://dist.libuv.org/dist/v1.45.0/libuv-v1.45.0.tar.gz" + "1.45.0"))) + (test-end) 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 diff --git a/tests/guix-home.sh b/tests/guix-home.sh index e6d16d7fab..649d811a0c 100644 --- a/tests/guix-home.sh +++ b/tests/guix-home.sh @@ -224,5 +224,5 @@ EOF # guix home search mcron | grep "^name: home-mcron" - guix home search job manager | grep "^name: home-mcron" + guix home search scheduling daemon | grep "^name: home-mcron" ) diff --git a/tests/guix-shell.sh b/tests/guix-shell.sh index ed368515eb..2f5fd86809 100644 --- a/tests/guix-shell.sh +++ b/tests/guix-shell.sh @@ -48,7 +48,7 @@ guix shell -s armhf-linux intelmetool -n && false # opens a couple of extra FDs. initial_fd_list="$(echo /proc/$$/fd/*)" fd_list="$(guix shell --bootstrap guile-bootstrap -- \ - "$SHELL" -c 'echo /proc/$$/fd/*')" + bash -c 'echo /proc/$$/fd/*')" test "$(echo $fd_list | wc -w)" -le "$(echo $initial_fd_list | wc -w)" # Ignoring unauthorized files. |