diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/gnu-maintenance.scm | 48 | ||||
| -rw-r--r-- | tests/import-utils.scm | 4 | ||||
| -rw-r--r-- | tests/lint.scm | 32 | ||||
| -rw-r--r-- | tests/services.scm | 68 |
4 files changed, 150 insertions, 2 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/import-utils.scm b/tests/import-utils.scm index 7b078eac05..229e6eafaa 100644 --- a/tests/import-utils.scm +++ b/tests/import-utils.scm @@ -61,6 +61,10 @@ Differences are hard to spot, e.g. in CLOS vs. GOOPS.")) "The term API is not code, but @code{myAPI} might be." (beautify-description "The term API is not code, but myAPI might be.")) +(test-equal "beautify-description: do not include punctuation when wrapping in @code" + "Code (@code{DelayedMatrix}, @code{MaMa}, or @code{MeMe}) should be wrapped." + (beautify-description "Code (DelayedMatrix, MaMa, or MeMe) should be wrapped.")) + (test-equal "license->symbol" 'license:lgpl2.0 (license->symbol license:lgpl2.0)) diff --git a/tests/lint.scm b/tests/lint.scm index b91bd053c5..a52a82237b 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -10,7 +10,7 @@ ;;; Copyright © 2020 Timothy Sample <samplet@ngyro.com> ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> -;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> +;;; Copyright © 2021, 2023 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -342,6 +342,36 @@ `(#:tests? ,(not (%current-target-system))))))) (check-tests-true pkg))) +(test-equal "compiler-for-target: unconditional CC=gcc is unacceptable" + "'CC' should be set to '(cc-for-target)' instead of 'gcc'" + (single-lint-warning-message + (check-compiler-for-target + (dummy-package "x" (arguments '(#:make-flags '("CC=gcc"))))))) + + +(test-equal "compiler-for-target: looks through G-expressions" + "'CC' should be set to '(cc-for-target)' instead of 'gcc'" + (single-lint-warning-message + (check-compiler-for-target + (dummy-package "x" (arguments '(#:make-flags #~'("CC=gcc"))))))) + +(test-equal "compiler-for-target: (cc-for-target) is acceptable" + '() + (check-compiler-for-target + (dummy-package "x" + (arguments + (list #:make-flags + #~(list (string-append "CC=" (cc-for-target)))))))) + +(test-equal "compiler-for-target: CC=gcc is acceptable when target=#false" + '() + (check-compiler-for-target + ;; This (dummy) package consists purely of architecture-independent data. + (dummy-package "tzdata" + (arguments + (list #:target #false + #:make-flags #~(list "CC=gcc")))))) + ;; The emacs-build-system sets #:tests? #f by default. (test-equal "tests-true: #:tests? #t acceptable for emacs packages" '() diff --git a/tests/services.scm b/tests/services.scm index 20ff4d317e..98b584f6c0 100644 --- a/tests/services.scm +++ b/tests/services.scm @@ -370,4 +370,72 @@ (modify-services services (t2 value => 22))))) +(test-error "modify-services: delete then modify" + #t + (let* ((t1 (service-type (name 't1) + (extensions '()) + (description ""))) + (t2 (service-type (name 't2) + (extensions '()) + (description ""))) + (t3 (service-type (name 't3) + (extensions '()) + (description ""))) + (services (list (service t1 1) (service t2 2) (service t3 3)))) + (map service-value + (modify-services services + (delete t2) + (t2 value => 22))))) + +(test-equal "modify-services: modify then delete" + '(2 3) + (let* ((t1 (service-type (name 't1) + (extensions '()) + (description ""))) + (t2 (service-type (name 't2) + (extensions '()) + (description ""))) + (t3 (service-type (name 't3) + (extensions '()) + (description ""))) + (services (list (service t1 1) (service t2 2) (service t3 3)))) + (map service-value + (modify-services services + (t1 value => 11) + (delete t1))))) + +(test-equal "modify-services: delete multiple services of the same type" + '(1 3) + (let* ((t1 (service-type (name 't1) + (extensions '()) + (description ""))) + (t2 (service-type (name 't2) + (extensions '()) + (description ""))) + (t3 (service-type (name 't3) + (extensions '()) + (description ""))) + (services (list (service t1 1) (service t2 2) + (service t2 2) (service t3 3)))) + (map service-value + (modify-services services + (delete t2))))) + +(test-equal "modify-services: modify multiple services of the same type" + '(1 12 13 4) + (let* ((t1 (service-type (name 't1) + (extensions '()) + (description ""))) + (t2 (service-type (name 't2) + (extensions '()) + (description ""))) + (t3 (service-type (name 't3) + (extensions '()) + (description ""))) + (services (list (service t1 1) (service t2 2) + (service t2 3) (service t3 4)))) + (map service-value + (modify-services services + (t2 value => (+ value 10)))))) + (test-end) |