diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/boot-parameters.scm | 2 | ||||
| -rw-r--r-- | tests/go.scm | 2 | ||||
| -rw-r--r-- | tests/guix-system.sh | 6 | ||||
| -rw-r--r-- | tests/import-utils.scm | 28 | ||||
| -rw-r--r-- | tests/minetest.scm | 355 | ||||
| -rw-r--r-- | tests/opam.scm | 58 | ||||
| -rw-r--r-- | tests/system.scm | 4 |
7 files changed, 418 insertions, 37 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/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-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/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/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) |