Merge branch 'master' into core-updates-frozen

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)