summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2021-10-12 16:50:47 +0000
committerMathieu Othacehe <othacehe@gnu.org>2021-10-12 17:46:23 +0000
commita1eca979fb8da842e73c42f4f53be29b169810f2 (patch)
tree681c7283e412bb8a29c2531c4408b49c3e184764 /tests
parent48d86a9ec6d8d2e97da2299ea41a03ef4cdaab83 (diff)
parent371aa5777a3805a3886f3feea5f1960fe3fe4219 (diff)
Merge remote-tracking branch 'origin/master' into core-updates-frozen.
Diffstat (limited to 'tests')
-rw-r--r--tests/channels.scm47
-rw-r--r--tests/git.scm28
-rw-r--r--tests/go.scm6
-rw-r--r--tests/graph.scm21
-rw-r--r--tests/guix-home.sh131
-rw-r--r--tests/import-git.scm245
-rw-r--r--tests/lint.scm23
-rw-r--r--tests/minetest.scm169
-rw-r--r--tests/opam.scm85
-rw-r--r--tests/pypi.scm106
10 files changed, 791 insertions, 70 deletions
diff --git a/tests/channels.scm b/tests/channels.scm
index 0264369d9e..3e82315b0c 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -408,6 +408,53 @@
'(#f "tag-for-first-news-entry")))))))
(unless (which (git-command)) (test-skip 1))
+(test-assert "channel-news, annotated tag"
+ (with-temporary-git-repository directory
+ `((add ".guix-channel"
+ ,(object->string
+ '(channel (version 0)
+ (news-file "news.scm"))))
+ (add "src/a.txt" "A")
+ (commit "first commit")
+ (tag "tag-for-first-news-entry"
+ "This is an annotated tag.")
+ (add "news.scm"
+ ,(lambda (repository)
+ (let ((previous
+ (reference-name->oid repository "HEAD")))
+ (object->string
+ `(channel-news
+ (version 0)
+ (entry (tag "tag-for-first-news-entry")
+ (title (en "New file!"))
+ (body (en "Yeah, a.txt."))))))))
+ (commit "second commit"))
+ (with-repository directory repository
+ (define (find-commit* message)
+ (oid->string (commit-id (find-commit repository message))))
+
+ (let ((channel (channel (url (string-append "file://" directory))
+ (name 'foo)))
+ (commit1 (find-commit* "first commit"))
+ (commit2 (find-commit* "second commit")))
+ (and (null? (channel-news-for-commit channel commit1))
+ (lset= equal?
+ (map channel-news-entry-title
+ (channel-news-for-commit channel commit2))
+ '((("en" . "New file!"))))
+ (lset= string=?
+ (map channel-news-entry-tag
+ (channel-news-for-commit channel commit2))
+ (list "tag-for-first-news-entry"))
+ ;; This is an annotated tag, but 'channel-news-entry-commit'
+ ;; should give us the commit ID, not the ID of the annotated tag
+ ;; object.
+ (lset= string=?
+ (map channel-news-entry-commit
+ (channel-news-for-commit channel commit2))
+ (list commit1)))))))
+
+(unless (which (git-command)) (test-skip 1))
(test-assert "latest-channel-instances, missing introduction for 'guix'"
(with-temporary-git-repository directory
'((add "a.txt" "A")
diff --git a/tests/git.scm b/tests/git.scm
index aa4f03ca62..d0646bbc85 100644
--- a/tests/git.scm
+++ b/tests/git.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
;;;
;;; This file is part of GNU Guix.
;;;
@@ -161,4 +162,31 @@
(commit-relation master1 merge)
(commit-relation merge master1))))))
+(unless (which (git-command)) (test-skip 1))
+(test-equal "remote-refs"
+ '("refs/heads/develop" "refs/heads/master"
+ "refs/tags/v1.0" "refs/tags/v1.1")
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "v1.0" "release-1.0")
+ (branch "develop")
+ (checkout "develop")
+ (add "b.txt" "B")
+ (commit "Second commit")
+ (tag "v1.1" "release-1.1"))
+ (remote-refs directory)))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "remote-refs: only tags"
+ '("refs/tags/v1.0" "refs/tags/v1.1")
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "v1.0" "Release 1.0")
+ (add "b.txt" "B")
+ (commit "Second commit")
+ (tag "v1.1" "Release 1.1"))
+ (remote-refs directory #:tags? #t)))
+
(test-end "git")
diff --git a/tests/go.scm b/tests/go.scm
index 9e7223ff7c..a70a0ddbf5 100644
--- a/tests/go.scm
+++ b/tests/go.scm
@@ -99,7 +99,7 @@ replace (
")
-(define fixture-go-mod-unparseable
+(define fixture-go-mod-unparsable
"module my/thing
go 1.12 // avoid feature X
require other/thing v1.0.2
@@ -263,7 +263,7 @@ require github.com/kr/pretty v0.2.1
(with (module-path "good/thing") (version "v1.4.5"))))
(parse-go.mod fixture-go-mod-simple))
-(test-equal "parse-go.mod: comments and unparseable lines"
+(test-equal "parse-go.mod: comments and unparsable lines"
`((module (module-path "my/thing"))
(go (version "1.12") (comment "avoid feature X"))
(require (module-path "other/thing") (version "v1.0.2"))
@@ -274,7 +274,7 @@ require github.com/kr/pretty v0.2.1
(with (module-path "good/thing") (version "v1.4.5")))
(comment "Unparseable")
(unknown "bad/thing [v1.4.5, v1.9.7] => good/thing v2.0.0"))
- (parse-go.mod fixture-go-mod-unparseable))
+ (parse-go.mod fixture-go-mod-unparsable))
(test-equal "parse-go.mod: retract"
`((retract (version "v0.9.1"))
diff --git a/tests/graph.scm b/tests/graph.scm
index e374dad1a5..fadac265f9 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -94,6 +94,25 @@ edges."
(list p3 p3 p2)
(list p2 p1 p1))))))))
+(test-assert "package DAG, limited depth"
+ (let-values (((backend nodes+edges) (make-recording-backend)))
+ (let* ((p1 (dummy-package "p1"))
+ (p2 (dummy-package "p2" (inputs `(("p1" ,p1)))))
+ (p3 (dummy-package "p3" (inputs `(("p1" ,p1)))))
+ (p4 (dummy-package "p4" (inputs `(("p2" ,p2) ("p3" ,p3))))))
+ (run-with-store %store
+ (export-graph (list p4) 'port
+ #:max-depth 1
+ #:node-type %package-node-type
+ #:backend backend))
+ ;; We should see nothing more than these 3 packages.
+ (let-values (((nodes edges) (nodes+edges)))
+ (and (equal? nodes (map package->tuple (list p4 p2 p3)))
+ (equal? edges
+ (map edge->tuple
+ (list p4 p4)
+ (list p2 p3))))))))
+
(test-assert "reverse package DAG"
(let-values (((backend nodes+edges) (make-recording-backend)))
(run-with-store %store
diff --git a/tests/guix-home.sh b/tests/guix-home.sh
new file mode 100644
index 0000000000..e578559c97
--- /dev/null
+++ b/tests/guix-home.sh
@@ -0,0 +1,131 @@
+
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2021 Andrew Tropin <andrew@trop.in>
+# Copyright © 2021 Oleg Pykhalov <go.wigust@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/>.
+
+#
+# Test the 'guix home' using the external store, if any.
+#
+
+set -e
+
+guix home --version
+
+NIX_STORE_DIR="$(guile -c '(use-modules (guix config))(display %storedir)')"
+localstatedir="$(guile -c '(use-modules (guix config))(display %localstatedir)')"
+GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
+export NIX_STORE_DIR GUIX_DAEMON_SOCKET
+
+# Run tests only when a "real" daemon is available.
+if ! guile -c '(use-modules (guix)) (exit (false-if-exception (open-connection)))'
+then
+ exit 77
+fi
+
+STORE_PARENT="$(dirname "$NIX_STORE_DIR")"
+export STORE_PARENT
+if test "$STORE_PARENT" = "/"; then exit 77; fi
+
+test_directory="$(mktemp -d)"
+trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
+
+(
+ cd "$test_directory" || exit 77
+
+ HOME="$test_directory"
+ export HOME
+
+ #
+ # Test 'guix home reconfigure'.
+ #
+
+ printf "# dot-bashrc test file for guix home" > "dot-bashrc"
+
+ cat > "home.scm" <<'EOF'
+(use-modules (guix gexp)
+ (gnu home)
+ (gnu home services)
+ (gnu home services shells)
+ (gnu services))
+
+(home-environment
+ (services
+ (list
+ (simple-service 'test-config
+ home-files-service-type
+ (list `("config/test.conf"
+ ,(plain-file
+ "tmp-file.txt"
+ "the content of ~/.config/test.conf"))))
+
+ (service home-bash-service-type
+ (home-bash-configuration
+ (guix-defaults? #t)
+ (bashrc
+ (list
+ (local-file (string-append (dirname (current-filename))
+ "/dot-bashrc"))))))
+
+ (simple-service 'home-bash-service-extension-test
+ home-bash-service-type
+ (home-bash-extension
+ (bashrc
+ (list
+ (plain-file
+ "bashrc-test-config.sh"
+ "# the content of bashrc-test-config.sh"))))))))
+EOF
+
+ guix home reconfigure "${test_directory}/home.scm"
+ test -d "${HOME}/.guix-home"
+ test -h "${HOME}/.bash_profile"
+ test -h "${HOME}/.bashrc"
+ test "$(tail -n 2 "${HOME}/.bashrc")" == "\
+# dot-bashrc test file for guix home
+# the content of bashrc-test-config.sh"
+ grep -q "the content of ~/.config/test.conf" "${HOME}/.config/test.conf"
+
+ #
+ # Test 'guix home describe'.
+ #
+
+ configuration_file()
+ {
+ guix home describe \
+ | grep 'configuration file:' \
+ | cut -d : -f 2 \
+ | xargs echo
+ }
+ test "$(cat "$(configuration_file)")" == "$(cat home.scm)"
+
+ canonical_file_name()
+ {
+ guix home describe \
+ | grep 'canonical file name:' \
+ | cut -d : -f 2 \
+ | xargs echo
+ }
+ test "$(canonical_file_name)" == "$(readlink "${HOME}/.guix-home")"
+
+ #
+ # Test 'guix home search'.
+ #
+
+ guix home search mcron | grep "^name: home-mcron"
+ guix home search job manager | grep "^name: home-mcron"
+)
diff --git a/tests/import-git.scm b/tests/import-git.scm
new file mode 100644
index 0000000000..f1bce154bb
--- /dev/null
+++ b/tests/import-git.scm
@@ -0,0 +1,245 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
+;;;
+;;; 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-import-git)
+ #:use-module (git)
+ #:use-module (guix git)
+ #:use-module (guix tests)
+ #:use-module (guix packages)
+ #:use-module (guix import git)
+ #:use-module (guix git-download)
+ #:use-module (guix tests git)
+ #:use-module (guix build utils)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-64))
+
+;; Test the (guix import git) tools.
+
+(test-begin "git")
+
+(define* (make-package directory version #:optional (properties '()))
+ (dummy-package "test-package"
+ (version version)
+ (properties properties)
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url (string-append "file://" directory))
+ (commit version)))
+ (sha256
+ (base32
+ "0000000000000000000000000000000000000000000000000000"))))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: no custom prefix, suffix, and delimiter"
+ "1.0.1"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "1.0.1" "Release 1.0.1"))
+ (let ((package (make-package directory "1.0.0")))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom prefix, no suffix and delimiter"
+ "1.0.1"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "prefix-1.0.1" "Release 1.0.1"))
+ (let ((package (make-package directory "1.0.0"
+ '((release-tag-prefix . "prefix-")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom suffix, no prefix and delimiter"
+ "1.0.1"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "1.0.1-suffix-123" "Release 1.0.1"))
+ (let ((package (make-package directory "1.0.0"
+ '((release-tag-suffix . "-suffix-[0-9]*")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom delimiter, no prefix and suffix"
+ "2021.09.07"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "2021-09-07" "Release 2021-09-07"))
+ (let ((package (make-package directory "2021-09-06"
+ '((release-tag-version-delimiter . "-")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: empty delimiter, no prefix and suffix"
+ "20210907"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "20210907" "Release 20210907"))
+ (let ((package (make-package directory "20210906"
+ '((release-tag-version-delimiter . "")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom prefix and suffix, no delimiter"
+ "2.0.0"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "Release-2.0.0suffix-1" "Release 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((release-tag-prefix . "Release-")
+ (release-tag-suffix . "suffix-[0-9]")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom prefix, suffix, and delimiter"
+ "2.0.0"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "Release-2_0_0suffix-1" "Release 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((release-tag-prefix . "Release-")
+ (release-tag-suffix . "suffix-[0-9]")
+ (release-tag-version-delimiter . "_")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: only pre-releases available"
+ #f
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "2.0.0-rc1" "Release candidate for 2.0.0"))
+ (let ((package (make-package directory "1.0.0")))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases"
+ "2.0.0-rc1"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "2.0.0-rc1" "Release candidate for 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom prefix"
+ "2.0.0-rc1"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "version-2.0.0-rc1" "Release candidate for 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)
+ (release-tag-prefix . "version-")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix"
+ "2.0.0-rc1"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "2.0.0-rc1-suffix" "Release candidate for 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)
+ (release-tag-suffix . "-suffix")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, delimiter conflicts with pre-release part"
+ "2.0.0_alpha"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "2_0_0_alpha" "Alpha release for 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)
+ (release-tag-version-delimiter . "_")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix and prefix"
+ "2.0.0-alpha"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "prefix123-2.0.0-alpha-suffix" "Alpha release for 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)
+ (release-tag-prefix . "prefix[0-9]{3}-")
+ (release-tag-suffix . "-suffix")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix, prefix, and delimiter"
+ "2.0.0-alpha"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "prefix123-2-0-0-alpha-suffix" "Alpha release for 2.0.0"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)
+ (release-tag-prefix . "prefix[0-9]{3}-")
+ (release-tag-suffix . "-suffix")
+ (release-tag-version-delimiter . "-")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, no delimiter, and custom suffix, prefix"
+ "2alpha"
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "prefix123-2alpha-suffix" "Alpha release for version 2"))
+ (let ((package (make-package directory "1.0.0"
+ '((accept-pre-releases? . #t)
+ (release-tag-prefix . "prefix[0-9]{3}-")
+ (release-tag-suffix . "-suffix")
+ (release-tag-version-delimiter . "")))))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: no tags found"
+ #f
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit"))
+ (let ((package (make-package directory "1.0.0")))
+ (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: no valid tags found"
+ #f
+ (with-temporary-git-repository directory
+ '((add "a.txt" "A")
+ (commit "First commit")
+ (tag "Test" "Test tag"))
+ (let ((package (make-package directory "1.0.0")))
+ (latest-git-tag-version package))))
+
+(test-end "git")
diff --git a/tests/lint.scm b/tests/lint.scm
index dfb45ef60d..ddef50b98b 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -1331,29 +1331,34 @@
(test-assert "haskell-stackage"
(let* ((stackage (string-append "{ \"packages\": [{"
- " \"name\":\"x\","
- " \"version\":\"1.0\" }]}"))
+ " \"name\":\"pandoc\","
+ " \"synopsis\":\"synopsis\","
+ " \"version\":\"1.0\" }],"
+ " \"snapshot\": {"
+ " \"ghc\": \"8.6.5\","
+ " \"name\": \"lts-14.27\""
+ " }}"))
(packages (map (lambda (version)
(dummy-package
- (string-append "ghc-x")
+ "ghc-pandoc"
(version version)
(source
(dummy-origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/"
- "x-" version "/x-" version ".tar.gz"))))))
- '("0.9" "1.0" "2.0")))
+ "pandoc-" version "/pandoc-" version ".tar.gz"))))))
+ '("0.9" "1.0" "100.0")))
(warnings (pk (with-http-server `((200 ,stackage) ; memoized
- (200 "name: x\nversion: 1.0\n")
- (200 "name: x\nversion: 1.0\n")
- (200 "name: x\nversion: 1.0\n"))
+ (200 "name: pandoc\nversion: 1.0\n")
+ (200 "name: pandoc\nversion: 1.0\n")
+ (200 "name: pandoc\nversion: 1.0\n"))
(parameterize ((%hackage-url (%local-url))
(%stackage-url (%local-url)))
(append-map check-haskell-stackage packages))))))
(match warnings
(((? lint-warning? warning))
- (and (string=? (package-version (lint-warning-package warning)) "2.0")
+ (and (string=? (package-version (lint-warning-package warning)) "100.0")
(string-contains (lint-warning-message warning)
"ahead of Stackage LTS version"))))))
diff --git a/tests/minetest.scm b/tests/minetest.scm
index 6ae476fe5f..77b9aa928f 100644
--- a/tests/minetest.scm
+++ b/tests/minetest.scm
@@ -17,10 +17,18 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-minetest)
+ #:use-module (guix build-system minetest)
+ #:use-module (guix upstream)
#:use-module (guix memoization)
#:use-module (guix import minetest)
#:use-module (guix import utils)
#:use-module (guix tests)
+ #:use-module (guix packages)
+ #:use-module (guix git-download)
+ #:use-module ((gnu packages minetest)
+ #:select (minetest minetest-technic))
+ #:use-module ((gnu packages base)
+ #:select (hello))
#:use-module (json)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@@ -33,6 +41,10 @@
(define* (make-package-sexp #:key
(guix-name "minetest-foo")
+ ;; This is not a proper version number but
+ ;; ContentDB often does not include version
+ ;; numbers.
+ (version "2021-07-25")
(home-page "https://example.org/foo")
(repo "https://example.org/foo.git")
(synopsis "synopsis")
@@ -44,9 +56,7 @@
#: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")
+ (version ,version)
(source
(origin
(method git-fetch)
@@ -106,14 +116,14 @@
author "/" name "/download/"))
("website" . ,website)))
-(define* (make-releases-json #:key (commit #f) (title "") #:allow-other-keys)
+(define* (make-releases-json #:key (commit #f) (title "2021-07-25") #: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"))))
+ ("title" . ,title))))
(define* (make-dependencies-json #:key (author "Author")
(name "foo")
@@ -247,14 +257,14 @@ during a dynamic extent where that package is available on ContentDB."
#:guix-name "minetest-foo-bar"
#:upstream-name "Author/foo_bar")
-(test-equal "elaborate names, unambigious"
+(test-equal "elaborate names, unambiguous"
"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)"
+(test-equal "elaborate name, ambiguous (highest score)"
"Jeija/mesecons"
(call-with-packages
;; #:sort "score" is the default
@@ -264,7 +274,7 @@ during a dynamic extent where that package is available on ContentDB."
'(#:name "mesecons" #:author "Jeija" #:score 999)))
-(test-equal "elaborate name, ambigious (most downloads)"
+(test-equal "elaborate name, ambiguous (most downloads)"
"Jeija/mesecons"
(call-with-packages
(cut elaborate-contentdb-name "mesecons" #:sort "downloads")
@@ -293,9 +303,20 @@ during a dynamic extent where that package is available on ContentDB."
#:repo 'null)
+;; Determining the version number
+
+(test-package "conventional version number" #:version "1.2.3" #:title "1.2.3")
+;; See e.g. orwell/basic_trains
+(test-package "v-prefixed version number" #:version "1.2.3" #:title "v1.2.3")
+;; Many mods on ContentDB use dates as release titles. In that case, the date
+;; will have to do.
+(test-package "dates as version number"
+ #:version "2021-01-01" #:title "2021-01-01")
+
+
;; Dependencies
-(test-package* "minetest->guix-package, unambigious dependency"
+(test-package* "minetest->guix-package, unambiguous dependency"
(list #:requirements '(("mesecons" #f
("Jeija/mesecons"
"some-modpack/containing-mese")))
@@ -303,7 +324,7 @@ during a dynamic extent where that package is available on ContentDB."
(list #:author "Jeija" #:name "mesecons")
(list #:author "some-modpack" #:name "containing-mese" #:type "modpack"))
-(test-package* "minetest->guix-package, ambigious dependency (highest score)"
+(test-package* "minetest->guix-package, ambiguous dependency (highest score)"
(list #:name "frobnicate"
#:guix-name "minetest-frobnicate"
#:upstream-name "Author/frobnicate"
@@ -314,7 +335,7 @@ during a dynamic extent where that package is available on ContentDB."
(list #:author "Author" #:name "foo" #:score 0)
(list #:author "Author" #:name "bar" #:score 9999))
-(test-package* "minetest->guix-package, ambigious dependency (most downloads)"
+(test-package* "minetest->guix-package, ambiguous dependency (most downloads)"
(list #:name "frobnicate"
#:guix-name "minetest-frobnicate"
#:upstream-name "Author/frobnicate"
@@ -331,6 +352,16 @@ during a dynamic extent where that package is available on ContentDB."
"some-modpack/containing-mese")))
#:inputs '())
+;; See e.g. 'orwell/basic_trains'
+(test-package* "minetest->guix-package, multiple dependencies implemented by one mod"
+ (list #:name "frobnicate"
+ #:guix-name "minetest-frobnicate"
+ #:upstream-name "Author/frobnicate"
+ #:requirements '(("frob" #f ("Author/frob"))
+ ("frob_x" #f ("Author/frob")))
+ #:inputs '("minetest-frob"))
+ (list #:author "Author" #:name "frob"))
+
;; License
(test-package "minetest->guix-package, identical licenses"
@@ -352,4 +383,120 @@ during a dynamic extent where that package is available on ContentDB."
(list z y x)
(sort-packages (list x y z))))
+
+
+;; Update detection
+(define (upstream-source->sexp upstream-source)
+ (define urls (upstream-source-urls upstream-source))
+ (unless (= 1 (length urls))
+ (error "only a single URL is expected"))
+ (define url (first urls))
+ `(,(upstream-source-package upstream-source)
+ ,(upstream-source-version upstream-source)
+ ,(git-reference-url url)
+ ,(git-reference-commit url)))
+
+(define* (expected-sexp #:key
+ (repo "https://example.org/foo.git")
+ (guix-name "minetest-foo")
+ (new-version "0.8")
+ (commit "44941798d222901b8f381b3210957d880b90a2fc")
+ #:allow-other-keys)
+ `(,guix-name ,new-version ,repo ,commit))
+
+(define* (example-package #:key
+ (source 'auto)
+ (repo "https://example.org/foo.git")
+ (old-version "0.8")
+ (commit "44941798d222901b8f381b3210957d880b90a2fc")
+ #:allow-other-keys)
+ (package
+ (name "minetest-foo")
+ (version old-version)
+ (source
+ (if (eq? source 'auto)
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url repo)
+ (commit commit #;"808f9ffbd3106da4c92d2367b118b98196c9e81e")))
+ (sha256 #f) ; not important for the following tests
+ (file-name (git-file-name name version)))
+ source))
+ (build-system minetest-mod-build-system)
+ (license #f)
+ (synopsis #f)
+ (description #f)
+ (home-page #f)
+ (properties '((upstream-name . "Author/foo")))))
+
+(define-syntax-rule (test-release test-case . arguments)
+ (test-equal test-case
+ (expected-sexp . arguments)
+ (and=>
+ (call-with-packages
+ (cut latest-minetest-release (example-package . arguments))
+ (list . arguments))
+ upstream-source->sexp)))
+
+(define-syntax-rule (test-no-release test-case . arguments)
+ (test-equal test-case
+ #f
+ (call-with-packages
+ (cut latest-minetest-release (example-package . arguments))
+ (list . arguments))))
+
+(test-release "same version"
+ #:old-version "0.8" #:title "0.8" #:new-version "0.8"
+ #:commit "44941798d222901b8f381b3210957d880b90a2fc")
+
+(test-release "new version (dotted)"
+ #:old-version "0.8" #:title "0.9.0" #:new-version "0.9.0"
+ #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a")
+
+(test-release "new version (date)"
+ #:old-version "2014-11-17" #:title "2015-11-04"
+ #:new-version "2015-11-04"
+ #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a")
+
+(test-release "new version (git -> dotted)"
+ #:old-version
+ (git-version "0.8" "1" "90422555f114d3af35e7cc4b5b6d59a5c226adc4")
+ #:title "0.9.0" #:new-version "0.9.0"
+ #:commit "90422555f114d3af35e7cc4b5b6d59a5c226adc4")
+
+;; There might actually be a new release, but guix cannot compare dates
+;; with regular version numbers.
+(test-no-release "dotted -> date"
+ #:old-version "0.8" #:title "2015-11-04"
+ #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a")
+
+(test-no-release "date -> dotted"
+ #:old-version "2014-11-07" #:title "0.8"
+ #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a")
+
+;; Don't let "guix refresh -t minetest" tell there are new versions
+;; if Guix has insufficient information to actually perform the update,
+;; when using --with-latest or "guix refresh -u".
+(test-no-release "no commit information, no new release"
+ #:old-version "0.8" #:title "0.9.0" #:new-version "0.9.0"
+ #:commit #false)
+
+(test-assert "minetest is not a minetest mod"
+ (not (minetest-package? minetest)))
+(test-assert "GNU hello is not a minetest mod"
+ (not (minetest-package? hello)))
+(test-assert "technic is a minetest mod"
+ (minetest-package? minetest-technic))
+(test-assert "upstream-name is required"
+ (not (minetest-package?
+ (package (inherit minetest-technic)
+ (properties '())))))
+
(test-end "minetest")
+
+;;; Local Variables:
+;;; eval: (put 'test-package* 'scheme-indent-function 1)
+;;; eval: (put 'test-release 'scheme-indent-function 1)
+;;; eval: (put 'test-no-release 'scheme-indent-function 1)
+;;; End:
diff --git a/tests/opam.scm b/tests/opam.scm
index f2e9a7103c..cf65ded168 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -72,45 +72,52 @@ url {
(test-begin "opam")
(test-assert "opam->guix-package"
- (mock ((guix import utils) url-fetch
- (lambda (url file-name)
- (match url
- ("https://example.org/foo-1.0.0.tar.gz"
- (begin
- (mkdir-p "foo-1.0.0")
- (system* "tar" "czvf" file-name "foo-1.0.0/")
- (delete-file-recursively "foo-1.0.0")
- (set! test-source-hash
- (call-with-input-file file-name port-sha256))))
- (_ (error "Unexpected URL: " url)))))
- (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)))))
+ (mock ((guix import opam) get-opam-repository
+ (const test-repo))
+ (mock ((guix import utils) url-fetch
+ (lambda (url file-name)
+ (match url
+ ("https://example.org/foo-1.0.0.tar.gz"
+ (begin
+ (mkdir-p "foo-1.0.0")
+ (system* "tar" "czvf" file-name "foo-1.0.0/")
+ (delete-file-recursively "foo-1.0.0")
+ (set! test-source-hash
+ (call-with-input-file file-name port-sha256))))
+ (_ (error "Unexpected URL: " url)))))
+ (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
+ ('quasiquote
+ (("ocaml-zarith" ('unquote 'ocaml-zarith)))))
+ ('native-inputs
+ ('quasiquote
+ (("ocaml-alcotest" ('unquote 'ocaml-alcotest))
+ ("ocamlbuild" ('unquote '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/pypi.scm b/tests/pypi.scm
index bb81e91839..43fb1d8628 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,7 +30,7 @@
#:use-module (srfi srfi-64)
#:use-module (ice-9 match))
-(define test-json
+(define test-json-1
"{
\"info\": {
\"version\": \"1.0.0\",
@@ -57,6 +58,34 @@
}
}")
+(define test-json-2
+ "{
+ \"info\": {
+ \"version\": \"1.0.0\",
+ \"name\": \"foo-99\",
+ \"license\": \"GNU LGPL\",
+ \"summary\": \"summary\",
+ \"home_page\": \"http://example.com\",
+ \"classifiers\": [],
+ \"download_url\": \"\"
+ },
+ \"urls\": [],
+ \"releases\": {
+ \"1.0.0\": [
+ {
+ \"url\": \"https://example.com/foo-99-1.0.0.egg\",
+ \"packagetype\": \"bdist_egg\"
+ }, {
+ \"url\": \"https://example.com/foo-99-1.0.0.tar.gz\",
+ \"packagetype\": \"sdist\"
+ }, {
+ \"url\": \"https://example.com/foo-99-1.0.0-py2.py3-none-any.whl\",
+ \"packagetype\": \"bdist_wheel\"
+ }
+ ]
+ }
+}")
+
(define test-source-hash
"")
@@ -147,6 +176,13 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
(uri (list "https://bitheap.org/cram/cram-0.7.tar.gz"
(pypi-uri "cram" "0.7"))))))))
+(test-equal "guix-package->pypi-name, honor 'upstream-name'"
+ "bar-3"
+ (guix-package->pypi-name
+ (dummy-package "foo"
+ (properties
+ '((upstream-name . "bar-3"))))))
+
(test-equal "specification->requirement-name"
'("Fizzy" "PickyThing" "SomethingWithMarker" "requests" "pip")
(map specification->requirement-name test-specifications))
@@ -198,8 +234,8 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
(lambda (url . rest)
(match url
("https://pypi.org/pypi/foo/json"
- (values (open-input-string test-json)
- (string-length test-json)))
+ (values (open-input-string test-json-1)
+ (string-length test-json-1)))
("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f)
(_ (error "Unexpected URL: " url)))))
(match (pypi->guix-package "foo")
@@ -259,8 +295,8 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
(lambda (url . rest)
(match url
("https://pypi.org/pypi/foo/json"
- (values (open-input-string test-json)
- (string-length test-json)))
+ (values (open-input-string test-json-1)
+ (string-length test-json-1)))
("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f)
(_ (error "Unexpected URL: " url)))))
;; Not clearing the memoization cache here would mean returning the value
@@ -307,8 +343,8 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
(lambda (url . rest)
(match url
("https://pypi.org/pypi/foo/json"
- (values (open-input-string test-json)
- (string-length test-json)))
+ (values (open-input-string test-json-1)
+ (string-length test-json-1)))
("https://example.com/foo-1.0.0-py2.py3-none-any.whl" #f)
(_ (error "Unexpected URL: " url)))))
;; Not clearing the memoization cache here would mean returning the value
@@ -335,4 +371,60 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
(x
(pk 'fail x #f))))))
+(test-assert "pypi->guix-package, package name contains \"-\" followed by digits"
+ ;; Replace network resources with sample data.
+ (mock ((guix import utils) url-fetch
+ (lambda (url file-name)
+ (match url
+ ("https://example.com/foo-99-1.0.0.tar.gz"
+ (begin
+ ;; Unusual requires.txt location should still be found.
+ (mkdir-p "foo-99-1.0.0/src/bizarre.egg-info")
+ (with-output-to-file "foo-99-1.0.0/src/bizarre.egg-info/requires.txt"
+ (lambda ()
+ (display test-requires.txt)))
+ (parameterize ((current-output-port (%make-void-port "rw+")))
+ (system* "tar" "czvf" file-name "foo-99-1.0.0/"))
+ (delete-file-recursively "foo-99-1.0.0")
+ (set! test-source-hash
+ (call-with-input-file file-name port-sha256))))
+ ("https://example.com/foo-99-1.0.0-py2.py3-none-any.whl" #f)
+ (_ (error "Unexpected URL: " url)))))
+ (mock ((guix http-client) http-fetch
+ (lambda (url . rest)
+ (match url
+ ("https://pypi.org/pypi/foo-99/json"
+ (values (open-input-string test-json-2)
+ (string-length test-json-2)))
+ ("https://example.com/foo-99-1.0.0-py2.py3-none-any.whl" #f)
+ (_ (error "Unexpected URL: " url)))))
+ (match (pypi->guix-package "foo-99")
+ (('package
+ ('name "python-foo-99")
+ ('version "1.0.0")
+ ('source ('origin
+ ('method 'url-fetch)
+ ('uri ('pypi-uri "foo-99" 'version))
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('properties ('quote (("upstream-name" . "foo-99"))))
+ ('build-system 'python-build-system)
+ ('propagated-inputs
+ ('quasiquote
+ (("python-bar" ('unquote 'python-bar))
+ ("python-foo" ('unquote 'python-foo)))))
+ ('native-inputs
+ ('quasiquote
+ (("python-pytest" ('unquote 'python-pytest)))))
+ ('home-page "http://example.com")
+ ('synopsis "summary")
+ ('description "summary")
+ ('license 'license:lgpl2.0))
+ (string=? (bytevector->nix-base32-string
+ test-source-hash)
+ hash))
+ (x
+ (pk 'fail x #f))))))
+
(test-end "pypi")