aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLiliana Marie Prikler <liliana.prikler@gmail.com>2023-09-09 12:22:14 +0200
committerLiliana Marie Prikler <liliana.prikler@gmail.com>2023-09-09 12:22:14 +0200
commit94ca5b4357af8f8921f0cb0873a7cf316f13aa69 (patch)
tree6ef30120737f26f298f7f17d86597b0b729517e0 /tests
parent6750c114e3e988249f4069d0180316c6d0192350 (diff)
parentdb61bdd7f52270a35bd0a3a88650d98276dab20b (diff)
downloadguix-94ca5b4357af8f8921f0cb0873a7cf316f13aa69.tar.gz
guix-94ca5b4357af8f8921f0cb0873a7cf316f13aa69.zip
Merge branch 'master' into emacs-team
Diffstat (limited to 'tests')
-rw-r--r--tests/gnu-maintenance.scm48
-rw-r--r--tests/import-utils.scm4
-rw-r--r--tests/lint.scm32
-rw-r--r--tests/services.scm68
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)