summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/boot-parameters.scm2
-rw-r--r--tests/builders.scm4
-rw-r--r--tests/go.scm2
-rw-r--r--tests/guix-build.sh4
-rw-r--r--tests/guix-system.sh6
-rw-r--r--tests/hackage.scm2
-rw-r--r--tests/import-utils.scm28
-rw-r--r--tests/minetest.scm355
-rw-r--r--tests/opam.scm58
-rw-r--r--tests/packages.scm11
-rw-r--r--tests/services/telephony.scm446
-rw-r--r--tests/store.scm36
-rw-r--r--tests/system.scm4
-rw-r--r--tests/transformations.scm51
14 files changed, 967 insertions, 42 deletions
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 3deae564c4..b2799d0596 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -81,7 +81,7 @@
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (target "/dev/sda")))
+ (targets '("/dev/sda"))))
(file-systems (cons* (file-system
(device %default-root-device)
(mount-point %root-path)
diff --git a/tests/builders.scm b/tests/builders.scm
index f609631ae7..2853227465 100644
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -25,6 +25,7 @@
#:use-module (guix build gnu-build-system)
#:use-module (guix build utils)
#:use-module (guix build-system python)
+ #:use-module (guix grafts)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix utils)
@@ -49,6 +50,9 @@
(define url-fetch*
(store-lower url-fetch))
+;; Globally disable grafts because they can trigger early builds.
+(%graft? #f)
+
(test-begin "builders")
diff --git a/tests/go.scm b/tests/go.scm
index 6749f4585f..9e7223ff7c 100644
--- a/tests/go.scm
+++ b/tests/go.scm
@@ -410,6 +410,6 @@ package.")
(nix-base32-string->bytevector
"0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5")
#f)))
- (go-module->guix-package "github.com/go-check/check")))))))
+ (go-module->guix-package* "github.com/go-check/check")))))))
(test-end "go")
diff --git a/tests/guix-build.sh b/tests/guix-build.sh
index e20702c521..3d2de092b1 100644
--- a/tests/guix-build.sh
+++ b/tests/guix-build.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2020 Marius Bakke <mbakke@fastmail.com>
# Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
#
@@ -278,7 +278,7 @@ guix build --target=arm-linux-gnueabihf --dry-run \
-e '(@ (gnu packages base) coreutils)'
# Replacements.
-drv1=`guix build guix --with-input=guile@2.0=guile@2.2 -d`
+drv1=`guix build guix --with-input=guile-zstd=idutils -d`
drv2=`guix build guix -d`
test "$drv1" != "$drv2"
diff --git a/tests/guix-system.sh b/tests/guix-system.sh
index 7e992e7bdb..6aab1f380a 100644
--- a/tests/guix-system.sh
+++ b/tests/guix-system.sh
@@ -115,7 +115,7 @@ cat > "$tmpfile" <<EOF
(timezone "Europe/Paris") ; 6
(locale "en_US.UTF-8") ; 7
- (bootloader (GRUB-config (target "/dev/sdX"))) ; 9
+ (bootloader (GRUB-config (targets (list "/dev/sdX")))) ; 9
(file-systems (cons (file-system
(device (file-system-label "root"))
(mount-point "/")
@@ -168,7 +168,7 @@ OS_BASE='
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (target "/dev/sdX")))
+ (targets (list "/dev/sdX"))))
(file-systems (cons (file-system
(device (file-system-label "root"))
(mount-point "/")
@@ -241,7 +241,7 @@ make_user_config ()
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (target "/dev/sdX")))
+ (targets (list "/dev/sdX"))))
(file-systems (cons (file-system
(device (file-system-label "root"))
(mount-point "/")
diff --git a/tests/hackage.scm b/tests/hackage.scm
index 073e35ad05..9919d54f47 100644
--- a/tests/hackage.scm
+++ b/tests/hackage.scm
@@ -312,8 +312,6 @@ executable cabal
mtl >= 2.0 && < 3
")
-;; Fails: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25138
-(test-expect-fail 1)
(test-assert "hackage->guix-package test flag executable"
(eval-test-with-cabal test-cabal-flag-executable match-ghc-foo))
diff --git a/tests/import-utils.scm b/tests/import-utils.scm
index 874816442e..7c6c782917 100644
--- a/tests/import-utils.scm
+++ b/tests/import-utils.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -64,6 +65,33 @@
'())))
#:guix-name identity))
+(test-equal "recursive-import: skip false packages (toplevel)"
+ '()
+ (recursive-import "foo"
+ #:repo 'repo
+ #:repo->guix-package
+ (match-lambda*
+ (("foo" #:version #f #:repo 'repo)
+ (values #f '())))
+ #:guix-name identity))
+
+(test-equal "recursive-import: skip false packages (dependency)"
+ '((package
+ (name "foo")
+ (inputs `(("bar" ,bar)))))
+ (recursive-import "foo"
+ #:repo 'repo
+ #:repo->guix-package
+ (match-lambda*
+ (("foo" #:version #f #:repo 'repo)
+ (values '(package
+ (name "foo")
+ (inputs `(("bar" ,bar))))
+ '("bar")))
+ (("bar" #:version #f #:repo 'repo)
+ (values #f '())))
+ #:guix-name identity))
+
(test-assert "alist->package with simple source"
(let* ((meta '(("name" . "hello")
("version" . "2.10")
diff --git a/tests/minetest.scm b/tests/minetest.scm
new file mode 100644
index 0000000000..6ae476fe5f
--- /dev/null
+++ b/tests/minetest.scm
@@ -0,0 +1,355 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-minetest)
+ #:use-module (guix memoization)
+ #:use-module (guix import minetest)
+ #:use-module (guix import utils)
+ #:use-module (guix tests)
+ #:use-module (json)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-64))
+
+
+;; Some procedures for populating a ‘fake’ ContentDB server.
+
+(define* (make-package-sexp #:key
+ (guix-name "minetest-foo")
+ (home-page "https://example.org/foo")
+ (repo "https://example.org/foo.git")
+ (synopsis "synopsis")
+ (guix-description "description")
+ (guix-license
+ '(list license:cc-by-sa4.0 license:lgpl3+))
+ (inputs '())
+ (upstream-name "Author/foo")
+ #:allow-other-keys)
+ `(package
+ (name ,guix-name)
+ ;; This is not a proper version number but ContentDB does not include
+ ;; version numbers.
+ (version "2021-07-25")
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url ,(and (not (eq? repo 'null)) repo))
+ (commit #f)))
+ (sha256
+ (base32 #f))
+ (file-name (git-file-name name version))))
+ (build-system minetest-mod-build-system)
+ ,@(maybe-propagated-inputs inputs)
+ (home-page ,home-page)
+ (synopsis ,synopsis)
+ (description ,guix-description)
+ (license ,guix-license)
+ (properties
+ ,(list 'quasiquote
+ `((upstream-name . ,upstream-name))))))
+
+(define* (make-package-json #:key
+ (author "Author")
+ (name "foo")
+ (media-license "CC-BY-SA-4.0")
+ (license "LGPL-3.0-or-later")
+ (short-description "synopsis")
+ (long-description "description")
+ (repo "https://example.org/foo.git")
+ (website "https://example.org/foo")
+ (forums 321)
+ (score 987.654)
+ (downloads 123)
+ (type "mod")
+ #:allow-other-keys)
+ `(("author" . ,author)
+ ("content_warnings" . #())
+ ("created_at" . "2018-05-23T19:58:07.422108")
+ ("downloads" . ,downloads)
+ ("forums" . ,forums)
+ ("issue_tracker" . "https://example.org/foo/issues")
+ ("license" . ,license)
+ ("long_description" . ,long-description)
+ ("maintainers" . #("maintainer"))
+ ("media_license" . ,media-license)
+ ("name" . ,name)
+ ("provides" . #("stuff"))
+ ("release" . 456)
+ ("repo" . ,repo)
+ ("score" . ,score)
+ ("screenshots" . #())
+ ("short_description" . ,short-description)
+ ("state" . "APPROVED")
+ ("tags" . #("some" "tags"))
+ ("thumbnail" . null)
+ ("title" . "The name")
+ ("type" . ,type)
+ ("url" . ,(string-append "https://content.minetest.net/packages/"
+ author "/" name "/download/"))
+ ("website" . ,website)))
+
+(define* (make-releases-json #:key (commit #f) (title "") #:allow-other-keys)
+ `#((("commit" . ,commit)
+ ("downloads" . 469)
+ ("id" . 8614)
+ ("max_minetest_version" . null)
+ ("min_minetest_version" . null)
+ ("release_date" . "2021-07-25T01:10:23.207584")
+ ("title" . "2021-07-25"))))
+
+(define* (make-dependencies-json #:key (author "Author")
+ (name "foo")
+ (requirements '(("default" #f ())))
+ #:allow-other-keys)
+ `((,(string-append author "/" name)
+ . ,(list->vector
+ (map (match-lambda
+ ((symbolic-name optional? implementations)
+ `(("is_optional" . ,optional?)
+ ("name" . ,symbolic-name)
+ ("packages" . ,(list->vector implementations)))))
+ requirements)))
+ ("something/else" . #())))
+
+(define* (make-packages-keys-json #:key (author "Author")
+ (name "Name")
+ (type "mod"))
+ `(("author" . ,author)
+ ("name" . ,name)
+ ("type" . ,type)))
+
+(define (call-with-packages thunk . argument-lists)
+ ;; Don't reuse results from previous tests.
+ (invalidate-memoization! contentdb-fetch)
+ (invalidate-memoization! minetest->guix-package)
+ (define (scm->json-port scm)
+ (open-input-string (scm->json-string scm)))
+ (define (handle-package url requested-author requested-name . rest)
+ (define relevant-argument-list
+ (any (lambda (argument-list)
+ (apply (lambda* (#:key (author "Author") (name "foo")
+ #:allow-other-keys)
+ (and (equal? requested-author author)
+ (equal? requested-name name)
+ argument-list))
+ argument-list))
+ argument-lists))
+ (when (not relevant-argument-list)
+ (error "the package ~a/~a should be irrelevant, but ~a is fetched"
+ requested-author requested-name url))
+ (scm->json-port
+ (apply (match rest
+ (("") make-package-json)
+ (("dependencies" "") make-dependencies-json)
+ (("releases" "") make-releases-json)
+ (_ (error "TODO ~a" rest)))
+ relevant-argument-list)))
+ (define (handle-mod-search sort)
+ ;; Produce search results, sorted by SORT in descending order.
+ (define arguments->key
+ (match sort
+ ("score" (lambda* (#:key (score 987.654) #:allow-other-keys)
+ score))
+ ("downloads" (lambda* (#:key (downloads 123) #:allow-other-keys)
+ downloads))))
+ (define argument-list->key (cut apply arguments->key <>))
+ (define (greater x y)
+ (> (argument-list->key x) (argument-list->key y)))
+ (define sorted-argument-lists (sort-list argument-lists greater))
+ (define* (arguments->json #:key (author "Author") (name "Foo") (type "mod")
+ #:allow-other-keys)
+ (and (string=? type "mod")
+ `(("author" . ,author)
+ ("name" . ,name)
+ ("type" . ,type))))
+ (define argument-list->json (cut apply arguments->json <>))
+ (scm->json-port
+ (list->vector (filter-map argument-list->json sorted-argument-lists))))
+ (mock ((guix http-client) http-fetch
+ (lambda* (url #:key headers)
+ (unless (string-prefix? "mock://api/packages/" url)
+ (error "the URL ~a should not be used" url))
+ (define resource
+ (substring url (string-length "mock://api/packages/")))
+ (define components (string-split resource #\/))
+ (match components
+ ((author name . rest)
+ (apply handle-package url author name rest))
+ (((? (cut string-prefix? "?type=mod&q=" <>) query))
+ (handle-mod-search
+ (cond ((string-contains query "sort=score") "score")
+ ((string-contains query "sort=downloads") "downloads")
+ (#t (error "search query ~a has unknown sort key"
+ query)))))
+ (_
+ (error "the URL ~a should have an author and name component"
+ url)))))
+ (parameterize ((%contentdb-api "mock://api/"))
+ (thunk))))
+
+(define* (minetest->guix-package* #:key (author "Author") (name "foo")
+ (sort %default-sort-key)
+ #:allow-other-keys)
+ (minetest->guix-package (string-append author "/" name) #:sort sort))
+
+(define (imported-package-sexp* primary-arguments . secondary-arguments)
+ "Ask the importer to import a package specified by PRIMARY-ARGUMENTS,
+during a dynamic where that package and the packages specified by
+SECONDARY-ARGUMENTS are available on ContentDB."
+ (apply call-with-packages
+ (lambda ()
+ ;; The memoization cache is reset by call-with-packages
+ (apply minetest->guix-package* primary-arguments))
+ primary-arguments
+ secondary-arguments))
+
+(define (imported-package-sexp . extra-arguments)
+ "Ask the importer to import a package specified by EXTRA-ARGUMENTS,
+during a dynamic extent where that package is available on ContentDB."
+ (imported-package-sexp* extra-arguments))
+
+(define-syntax-rule (test-package test-case . extra-arguments)
+ (test-equal test-case
+ (make-package-sexp . extra-arguments)
+ (imported-package-sexp . extra-arguments)))
+
+(define-syntax-rule (test-package* test-case primary-arguments extra-arguments
+ ...)
+ (test-equal test-case
+ (apply make-package-sexp primary-arguments)
+ (imported-package-sexp* primary-arguments extra-arguments ...)))
+
+(test-begin "minetest")
+
+
+;; Package names
+(test-package "minetest->guix-package")
+(test-package "minetest->guix-package, _ → - in package name"
+ #:name "foo_bar"
+ #:guix-name "minetest-foo-bar"
+ #:upstream-name "Author/foo_bar")
+
+(test-equal "elaborate names, unambigious"
+ "Jeija/mesecons"
+ (call-with-packages
+ (cut elaborate-contentdb-name "mesecons")
+ '(#:name "mesecons" #:author "Jeija")
+ '(#:name "something" #:author "else")))
+
+(test-equal "elaborate name, ambigious (highest score)"
+ "Jeija/mesecons"
+ (call-with-packages
+ ;; #:sort "score" is the default
+ (cut elaborate-contentdb-name "mesecons")
+ '(#:name "mesecons" #:author "Jeijc" #:score 777)
+ '(#:name "mesecons" #:author "Jeijb" #:score 888)
+ '(#:name "mesecons" #:author "Jeija" #:score 999)))
+
+
+(test-equal "elaborate name, ambigious (most downloads)"
+ "Jeija/mesecons"
+ (call-with-packages
+ (cut elaborate-contentdb-name "mesecons" #:sort "downloads")
+ '(#:name "mesecons" #:author "Jeijc" #:downloads 777)
+ '(#:name "mesecons" #:author "Jeijb" #:downloads 888)
+ '(#:name "mesecons" #:author "Jeija" #:downloads 999)))
+
+
+;; Determining the home page
+(test-package "minetest->guix-package, website is used as home page"
+ #:home-page "web://site"
+ #:website "web://site")
+(test-package "minetest->guix-package, if absent, the forum is used"
+ #:home-page '(minetest-topic 628)
+ #:forums 628
+ #:website 'null)
+(test-package "minetest->guix-package, if absent, the git repo is used"
+ #:home-page "https://github.com/minetest-mods/mesecons"
+ #:forums 'null
+ #:website 'null
+ #:repo "https://github.com/minetest-mods/mesecons")
+(test-package "minetest->guix-package, all home page information absent"
+ #:home-page #f
+ #:forums 'null
+ #:website 'null
+ #:repo 'null)
+
+
+
+;; Dependencies
+(test-package* "minetest->guix-package, unambigious dependency"
+ (list #:requirements '(("mesecons" #f
+ ("Jeija/mesecons"
+ "some-modpack/containing-mese")))
+ #:inputs '("minetest-mesecons"))
+ (list #:author "Jeija" #:name "mesecons")
+ (list #:author "some-modpack" #:name "containing-mese" #:type "modpack"))
+
+(test-package* "minetest->guix-package, ambigious dependency (highest score)"
+ (list #:name "frobnicate"
+ #:guix-name "minetest-frobnicate"
+ #:upstream-name "Author/frobnicate"
+ #:requirements '(("frob" #f
+ ("Author/foo" "Author/bar")))
+ ;; #:sort "score" is the default
+ #:inputs '("minetest-bar"))
+ (list #:author "Author" #:name "foo" #:score 0)
+ (list #:author "Author" #:name "bar" #:score 9999))
+
+(test-package* "minetest->guix-package, ambigious dependency (most downloads)"
+ (list #:name "frobnicate"
+ #:guix-name "minetest-frobnicate"
+ #:upstream-name "Author/frobnicate"
+ #:requirements '(("frob" #f
+ ("Author/foo" "Author/bar")))
+ #:inputs '("minetest-bar")
+ #:sort "downloads")
+ (list #:author "Author" #:name "foo" #:downloads 0)
+ (list #:author "Author" #:name "bar" #:downloads 9999))
+
+(test-package "minetest->guix-package, optional dependency"
+ #:requirements '(("mesecons" #t
+ ("Jeija/mesecons"
+ "some-modpack/containing-mese")))
+ #:inputs '())
+
+
+;; License
+(test-package "minetest->guix-package, identical licenses"
+ #:guix-license 'license:lgpl3+
+ #:license "LGPL-3.0-or-later"
+ #:media-license "LGPL-3.0-or-later")
+
+;; Sorting
+(let* ((make-package
+ (lambda arguments
+ (json->package (apply make-package-json arguments))))
+ (x (make-package #:score 0))
+ (y (make-package #:score 1))
+ (z (make-package #:score 2)))
+ (test-equal "sort-packages, already sorted"
+ (list z y x)
+ (sort-packages (list z y x)))
+ (test-equal "sort-packages, reverse"
+ (list z y x)
+ (sort-packages (list x y z))))
+
+(test-end "minetest")
diff --git a/tests/opam.scm b/tests/opam.scm
index e7f1ff9e39..f2e9a7103c 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -83,36 +83,34 @@ url {
(set! test-source-hash
(call-with-input-file file-name port-sha256))))
(_ (error "Unexpected URL: " url)))))
- (mock ((guix import opam) get-opam-repository
- (const test-repo))
- (let ((my-package (string-append test-repo
- "/packages/foo/foo.1.0.0")))
- (mkdir-p my-package)
- (with-output-to-file (string-append my-package "/opam")
- (lambda _
- (format #t "~a" test-opam-file))))
- (match (opam->guix-package "foo" #:repo test-repo)
- (('package
- ('name "ocaml-foo")
- ('version "1.0.0")
- ('source ('origin
- ('method 'url-fetch)
- ('uri "https://example.org/foo-1.0.0.tar.gz")
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'ocaml-build-system)
- ('propagated-inputs ('list 'ocaml-zarith))
- ('native-inputs ('list 'ocaml-alcotest 'ocamlbuild))
- ('home-page "https://example.org/")
- ('synopsis "Some example package")
- ('description "This package is just an example.")
- ('license 'license:bsd-3))
- (string=? (bytevector->nix-base32-string
- test-source-hash)
- hash))
- (x
- (pk 'fail x #f))))))
+ (let ((my-package (string-append test-repo
+ "/packages/foo/foo.1.0.0")))
+ (mkdir-p my-package)
+ (with-output-to-file (string-append my-package "/opam")
+ (lambda _
+ (format #t "~a" test-opam-file))))
+ (match (opam->guix-package "foo" #:repo (list test-repo))
+ (('package
+ ('name "ocaml-foo")
+ ('version "1.0.0")
+ ('source ('origin
+ ('method 'url-fetch)
+ ('uri "https://example.org/foo-1.0.0.tar.gz")
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('build-system 'ocaml-build-system)
+ ('propagated-inputs ('list 'ocaml-zarith))
+ ('native-inputs ('list 'ocaml-alcotest 'ocamlbuild))
+ ('home-page "https://example.org/")
+ ('synopsis "Some example package")
+ ('description "This package is just an example.")
+ ('license 'license:bsd-3))
+ (string=? (bytevector->nix-base32-string
+ test-source-hash)
+ hash))
+ (x
+ (pk 'fail x #f)))))
;; Test the opam file parser
;; We fold over some test cases. Each case is a pair of the string to parse and the
diff --git a/tests/packages.scm b/tests/packages.scm
index 2e1ca10dc4..46f4da1494 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -241,6 +241,17 @@
(eq? item new)))
(null? (manifest-transaction-remove tx)))))))
+(test-assert "package-definition-location"
+ (let ((location (package-location hello))
+ (definition (package-definition-location hello)))
+ ;; Check for the usual layout of (define-public hello (package ...)).
+ (and (string=? (location-file location)
+ (location-file definition))
+ (= 0 (location-column definition))
+ (= 2 (location-column location))
+ (= (location-line definition)
+ (- (location-line location) 1)))))
+
(test-assert "package-field-location"
(let ()
(define (goto port line column)
diff --git a/tests/services/telephony.scm b/tests/services/telephony.scm
new file mode 100644
index 0000000000..b4a0f120d4
--- /dev/null
+++ b/tests/services/telephony.scm
@@ -0,0 +1,446 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (tests services telephony)
+ #:use-module (gnu build jami-service)
+ #:use-module (gnu services telephony)
+ #:use-module (srfi srfi-64))
+
+;;; Tests for the (gnu services telephony) and related modules.
+
+(test-begin "jami-service")
+
+(define parse-dbus-reply
+ (@@ (gnu build jami-service) parse-dbus-reply))
+
+(define parse-account-ids
+ (@@ (gnu build jami-service) parse-account-ids))
+
+(define parse-account-details
+ (@@ (gnu build jami-service) parse-account-details))
+
+(define parse-contacts
+ (@@ (gnu build jami-service) parse-contacts))
+
+(define jami-account->alist
+ (@@ (gnu services telephony) jami-account->alist))
+
+;; $ dbus-send --print-reply --dest="cx.ring.Ring" \
+;; "/cx/ring/Ring/ConfigurationManager" \
+;; "cx.ring.Ring.ConfigurationManager.getAccountList"
+(define getAccountList-reply "\
+method return time=1622217253.386711 sender=:1.7 -> destination=:1.14 serial=140 reply_serial=2
+ array [
+ string \"addf37fbb558d6a0\"
+ string \"d5cbeb7d08c98a65\"
+ string \"398af0c6b74ce101\"
+ ]
+")
+
+(test-equal "parse-account-ids"
+ '("addf37fbb558d6a0" "d5cbeb7d08c98a65" "398af0c6b74ce101")
+ (parse-account-ids getAccountList-reply))
+
+;; $ dbus-send --print-reply --dest="cx.ring.Ring" \
+;; "/cx/ring/Ring/ConfigurationManager" \
+;; "cx.ring.Ring.ConfigurationManager.getAccountDetails" \
+;; 'string:398af0c6b74ce101'
+(define getAccountDetails-reply "\
+method return time=1622254991.789588 sender=:1.7 -> destination=:1.19 serial=145 reply_serial=2
+ array [
+ dict entry(
+ string \"Account.accountDiscovery\"
+ string \"false\"
+ )
+ dict entry(
+ string \"Account.accountPublish\"
+ string \"false\"
+ )
+ dict entry(
+ string \"Account.activeCallLimit\"
+ string \"-1\"
+ )
+ dict entry(
+ string \"Account.alias\"
+ string \"some-rendezvous-point-name\"
+ )
+ dict entry(
+ string \"Account.allModeratorEnabled\"
+ string \"true\"
+ )
+ dict entry(
+ string \"Account.allowCertFromContact\"
+ string \"true\"
+ )
+ dict entry(
+ string \"Account.allowCertFromHistory\"
+ string \"true\"
+ )
+ dict entry(
+ string \"Account.allowCertFromTrusted\"
+ string \"true\"
+ )
+ dict entry(
+ string \"Account.archiveHasPassword\"
+ string \"false\"
+ )
+ dict entry(
+ string \"Account.audioPortMax\"
+ string \"32766\"
+ )
+ dict entry(
+ string \"Account.audioPortMin\"
+ string \"16384\"
+ )
+ dict entry(
+ string \"Account.autoAnswer\"
+ string \"false\"
+ )
+ dict entry(
+ string \"Account.defaultModerators\"
+ string \"\"
+ )
+ dict entry(
+ string \"Account.deviceID\"
+ string \"94b4070fc7a8afa8482c777a9822c52e6af2e1bd\"
+ )
+ dict entry(
+ string \"Account.deviceName\"
+ string \"some-device\"
+ )
+ dict entry(
+ string \"Account.dhtProxyListUrl\"
+ string \"https://config.jami.net/proxyList\"
+ )
+ dict entry(
+ string \"Account.displayName\"
+ string \"some-rendezvous-point-name\"
+ )
+ dict entry(
+ string \"Account.dtmfType\"
+ string \"overrtp\"
+ )
+ dict entry(
+ string \"Account.enable\"
+ string \"true\"
+ )
+ dict entry(
+ string \"Account.hasCustomUserAgent\"
+ string \"false\"
+ )
+ dict entry(
+ string \"Account.hostname\"
+ string \"bootstrap.jami.net\"
+ )
+ dict entry(
+ string \"Account.localInterface\"
+ string \"default\"
+ )
+ dict entry(
+ string \"Account.localModeratorsEnabled\"
+ string \"true\"
+ )
+ dict entry(
+ string \"Account.mailbox\"
+ string \"\"
+ )
+ dict entry(
+ string \"Account.managerUri\"
+ string \"\"
+ )
+ dict entry(
+ string \"Account.managerUsername\"
+ string \"\"
+ )
+ dict entry(
+ string \"Account.peerDiscovery\"
+ string \"false\"
+ )
+ dict entry(
+ string \"Account.presenceSubscribeSupported\"
+ string \"true\"
+ )
+ dict entry(
+ string \"Account.proxyEnabled\"
+ string \"false\"
+ )
+ dict entry(
+ string \"Account.proxyPushToken\"
+ string \"\"
+ )
+ dict entry(
+ string \"Account.proxyServer\"
+ string \"dhtproxy.jami.net:[80-95]\"
+ )
+ dict entry(
+ string \"Account.publishedAddress\"
+ string \"\"
+ )
+ dict entry(
+ string \"Account.publishedPort\"
+ string \"5060\"
+ )
+ dict entry(
+ string \"Account.publishedSameAsLocal\"
+ string \"true\"
+ )
+ dict entry(
+ string \"Account.rendezVous\"
+ string \"true\"
+ )
+ dict entry(
+ string \"Account.ringtoneEnabled\"
+ string \"true\"
+ )
+ dict entry(
+ string \"Account.ringtonePath\"
+ string \"/usr/share/ring/ringtones/default.opus\"
+ )
+ dict entry(
+ string \"Account.type\"
+ string \"RING\"
+ )
+ dict entry(
+ string \"Account.upnpEnabled\"
+ string \"true\"
+ )
+ dict entry(
+ string \"Account.useragent\"
+ string \"\"
+ )
+ dict entry(
+ string \"Account.username\"
+ string \"ccb8bbe2382343f7feb140710ab48aaf1b55634e\"
+ )
+ dict entry(
+ string \"Account.videoEnabled\"
+ string \"true\"
+ )
+ dict entry(
+ string \"Account.videoPortMax\"
+ string \"65534\"
+ )
+ dict entry(
+ string \"Account.videoPortMin\"
+ string \"49152\"
+ )
+ dict entry(
+ string \"DHT.PublicInCalls\"
+ string \"true\"
+ )
+ dict entry(
+ string \"DHT.port\"
+ string \"7766\"
+ )
+ dict entry(
+ string \"RingNS.account\"
+ string \"3989b55313a911b6f0c004748b49b254f35c9ef6\"
+ )
+ dict entry(
+ string \"RingNS.uri\"
+ string \"\"
+ )
+ dict entry(
+ string \"SRTP.enable\"
+ string \"true\"
+ )
+ dict entry(
+ string \"SRTP.keyExchange\"
+ string \"sdes\"
+ )
+ dict entry(
+ string \"SRTP.rtpFallback\"
+ string \"false\"
+ )
+ dict entry(
+ string \"STUN.enable\"
+ string \"false\"
+ )
+ dict entry(
+ string \"STUN.server\"
+ string \"\"
+ )
+ dict entry(
+ string \"TLS.certificateFile\"
+ string \"/var/lib/jami/.local/share/jami/398af0c6b74ce101/ring_device.crt\"
+ )
+ dict entry(
+ string \"TLS.certificateListFile\"
+ string \"\"
+ )
+ dict entry(
+ string \"TLS.ciphers\"
+ string \"\"
+ )
+ dict entry(
+ string \"TLS.method\"
+ string \"Automatic\"
+ )
+ dict entry(
+ string \"TLS.negotiationTimeoutSec\"
+ string \"-1\"
+ )
+ dict entry(
+ string \"TLS.password\"
+ string \"\"
+ )
+ dict entry(
+ string \"TLS.privateKeyFile\"
+ string \"/var/lib/jami/.local/share/jami/398af0c6b74ce101/ring_device.key\"
+ )
+ dict entry(
+ string \"TLS.requireClientCertificate\"
+ string \"true\"
+ )
+ dict entry(
+ string \"TLS.serverName\"
+ string \"\"
+ )
+ dict entry(
+ string \"TLS.verifyClient\"
+ string \"true\"
+ )
+ dict entry(
+ string \"TLS.verifyServer\"
+ string \"true\"
+ )
+ dict entry(
+ string \"TURN.enable\"
+ string \"true\"
+ )
+ dict entry(
+ string \"TURN.password\"
+ string \"ring\"
+ )
+ dict entry(
+ string \"TURN.realm\"
+ string \"ring\"
+ )
+ dict entry(
+ string \"TURN.server\"
+ string \"turn.jami.net\"
+ )
+ dict entry(
+ string \"TURN.username\"
+ string \"ring\"
+ )
+ ]
+")
+
+(test-equal "parse-account-details; username, alias and display name"
+ '("ccb8bbe2382343f7feb140710ab48aaf1b55634e" ;username
+ "some-rendezvous-point-name" ;alias
+ "some-rendezvous-point-name") ;displayName
+ (let ((account-details (parse-account-details getAccountDetails-reply)))
+ (list (assoc-ref account-details "Account.username")
+ (assoc-ref account-details "Account.alias")
+ (assoc-ref account-details "Account.displayName"))))
+
+(define getContacts-reply "\
+method return time=1627014042.752673 sender=:1.113 -> destination=:1.186 serial=220 reply_serial=2
+ array [
+ array [
+ dict entry(
+ string \"added\"
+ string \"1578883327\"
+ )
+ dict entry(
+ string \"confirmed\"
+ string \"true\"
+ )
+ dict entry(
+ string \"id\"
+ string \"1c7d5a09464223442549fef172a3cf6f4de9b01c\"
+ )
+ ]
+ array [
+ dict entry(
+ string \"added\"
+ string \"1623107941\"
+ )
+ dict entry(
+ string \"confirmed\"
+ string \"true\"
+ )
+ dict entry(
+ string \"id\"
+ string \"5903c6c9ac5cb863c64e559add3d5d1c8c563449\"
+ )
+ ]
+ array [
+ dict entry(
+ string \"added\"
+ string \"1595996256\"
+ )
+ dict entry(
+ string \"confirmed\"
+ string \"true\"
+ )
+ dict entry(
+ string \"id\"
+ string \"ff2d72a548693214fb3a0f0f7a943b5e2bb9be03\"
+ )
+ ]
+ ]")
+
+(test-equal "parse-account-contacts"
+ '((("added" . "1578883327")
+ ("confirmed" . "true")
+ ("id" . "1c7d5a09464223442549fef172a3cf6f4de9b01c"))
+ (("added" . "1623107941")
+ ("confirmed" . "true")
+ ("id" . "5903c6c9ac5cb863c64e559add3d5d1c8c563449"))
+ (("added" . "1595996256")
+ ("confirmed" . "true")
+ ("id" . "ff2d72a548693214fb3a0f0f7a943b5e2bb9be03")))
+ (parse-contacts getContacts-reply))
+
+(define getContacts-empty-reply "\
+method return time=1627400787.873988 sender=:1.1197 -> destination=:1.1463 serial=2127 reply_serial=2
+ array [
+ ]")
+
+(test-equal "parse-account-contacts, empty array"
+ '()
+ (parse-contacts getContacts-empty-reply))
+
+(define %dummy-jami-account (jami-account
+ (archive "/tmp/dummy.gz")))
+
+(define %dummy-jami-account-2 (jami-account
+ (archive "/tmp/dummy.gz")
+ (rendezvous-point? #t)
+ (peer-discovery? #f)
+ (bootstrap-hostnames '("bootstrap.me"
+ "fallback.another.host"))
+ (name-server-uri "https://my.name.server")))
+
+(test-equal "jami-account->alist, no account detail value set"
+ '()
+ (jami-account->alist %dummy-jami-account))
+
+(test-equal "jami-account->alist, with account detail values"
+ '(("Account.hostname" . "bootstrap.me;fallback.another.host")
+ ("Account.peerDiscovery" . "false")
+ ("Account.rendezVous" . "true")
+ ("RingNS.uri" . "https://my.name.server"))
+ (sort (jami-account->alist %dummy-jami-account-2)
+ (lambda (x y)
+ (string<=? (car x) (car y)))))
+
+(test-end)
diff --git a/tests/store.scm b/tests/store.scm
index d77c26192a..d895a328a4 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -454,6 +454,42 @@
(derivation->output-path drv)))
(list d1 d2)))))
+(test-equal "map/accumulate-builds cutoff" ;https://issues.guix.gnu.org/50264
+ (iota 20)
+
+ ;; Make sure that, when the cutoff is reached, 'map/accumulate-builds' still
+ ;; returns the right result and calls the build handler by batches.
+ (let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))
+ (s (add-to-store %store "bash" #t "sha256"
+ (search-bootstrap-binary "bash"
+ (%current-system))))
+ (d (map (lambda (i)
+ (derivation %store (string-append "the-thing-"
+ (number->string i))
+ s `("-e" ,b)
+ #:env-vars `(("foo" . ,(random-text)))
+ #:sources (list b s)
+ #:properties `((n . ,i))))
+ (iota 20)))
+ (calls '()))
+ (define lst
+ (with-build-handler (lambda (continue store things mode)
+ (set! calls (cons things calls))
+ (continue #f))
+ (map/accumulate-builds %store
+ (lambda (d)
+ (build-derivations %store (list d))
+ (assq-ref (derivation-properties d) 'n))
+ d
+ #:cutoff 7)))
+
+ (match (reverse calls)
+ (((batch1 ...) (batch2 ...) (batch3 ...))
+ (and (equal? (map derivation-file-name (take d 8)) batch1)
+ (equal? (map derivation-file-name (take (drop d 8) 8)) batch2)
+ (equal? (map derivation-file-name (drop d 16)) batch3)
+ lst)))))
+
(test-assert "mapm/accumulate-builds"
(let* ((d1 (run-with-store %store
(gexp->derivation "foo" #~(mkdir #$output))))
diff --git a/tests/system.scm b/tests/system.scm
index 9416b950e6..019c720e65 100644
--- a/tests/system.scm
+++ b/tests/system.scm
@@ -39,7 +39,7 @@
(locale "en_US.utf8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (target "/dev/sdX")))
+ (targets '("/dev/sdX"))))
(file-systems (cons %root-fs %base-file-systems))
(users %base-user-accounts)))
@@ -56,7 +56,7 @@
(locale "en_US.utf8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (target "/dev/sdX")))
+ (targets '("/dev/sdX"))))
(mapped-devices (list %luks-device))
(file-systems (cons (file-system
(inherit %root-fs)
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 902bd45a6a..09839dc1c5 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,7 +30,10 @@
#:use-module (guix build-system)
#:use-module (guix build-system gnu)
#:use-module (guix transformations)
- #:use-module ((guix gexp) #:select (local-file? local-file-file))
+ #:use-module ((guix gexp)
+ #:select (local-file? local-file-file
+ computed-file? computed-file-gexp
+ gexp-input-thing))
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix git)
@@ -232,6 +236,26 @@
(string=? (package-name dep2) "chbouib")
(package-source dep2))))))))
+(test-equal "options->transformation, with-commit, version transformation"
+ '("1.0" "1.0-rc1-2-gabc123" "git.abc123")
+ (map (lambda (commit)
+ (let* ((p (dummy-package "guix.scm"
+ (inputs `(("foo" ,(dummy-package "chbouib"
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://example.org")
+ (commit "cabba9e")))
+ (sha256 #f)))))))))
+ (t (options->transformation
+ `((with-commit . ,(string-append "chbouib=" commit))))))
+ (let ((new (t p)))
+ (and (not (eq? new p))
+ (match (package-inputs new)
+ ((("foo" dep1))
+ (package-version dep1)))))))
+ '("v1.0" "1.0-rc1-2-gabc123" "abc123")))
+
(test-equal "options->transformation, with-git-url"
(let ((source (git-checkout (url "https://example.org")
(recursive? #t))))
@@ -400,6 +424,31 @@
(map local-file-file
(origin-patches (package-source dep)))))))))
+(test-equal "options->transformation, with-commit + with-patch"
+ '(#t #t)
+ (let* ((patch (search-patch "glibc-locales.patch"))
+ (commit "f8934ec94df5868ee8baf1fb0f8ed0f24e7e91eb")
+ (t (options->transformation
+ ;; Note: options are applied in reverse order, so
+ ;; 'with-patch' comes on top.
+ `((with-patch . ,(string-append "guile-gcrypt=" patch))
+ (with-commit
+ . ,(string-append "guile-gcrypt=" commit))))))
+ (let ((new (t (@ (gnu packages gnupg) guile-gcrypt))))
+ (match (package-source new)
+ ((? computed-file? source)
+ (let* ((gexp (computed-file-gexp source))
+ (inputs (map gexp-input-thing
+ ((@@ (guix gexp) gexp-inputs) gexp))))
+ (list (any (lambda (input)
+ (and (git-checkout? input)
+ (string=? commit (git-checkout-commit input))))
+ inputs)
+ (any (lambda (input)
+ (and (local-file? input)
+ (string=? (local-file-file input) patch)))
+ inputs))))))))
+
(test-equal "options->transformation, with-latest"
"42.0"
(mock ((guix upstream) %updaters
generated by cgit v1.2.3 (git 2.50.1) at 2025-08-05 07:07:24 +0000