summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/build-utils.scm57
-rw-r--r--tests/channels.scm18
-rw-r--r--tests/git-authenticate.scm23
-rw-r--r--tests/gremlin.scm28
-rw-r--r--tests/guix-authenticate.sh4
-rw-r--r--tests/guix-graph.sh5
-rw-r--r--tests/guix-hash.sh3
-rw-r--r--tests/guix-package-net.sh21
-rw-r--r--tests/home-import.scm14
-rw-r--r--tests/import-github.scm139
-rw-r--r--tests/keys/civodul.pub (renamed from tests/civodul.key)0
-rw-r--r--tests/keys/dsa.pub (renamed from tests/dsa.key)0
-rw-r--r--tests/keys/ed25519-2.pub (renamed from tests/ed25519bis.key)0
-rw-r--r--tests/keys/ed25519-2.sec (renamed from tests/ed25519bis.sec)0
-rw-r--r--tests/keys/ed25519-3.pub9
-rw-r--r--tests/keys/ed25519-3.sec10
-rw-r--r--tests/keys/ed25519.pub (renamed from tests/ed25519.key)0
-rw-r--r--tests/keys/ed25519.sec (renamed from tests/ed25519.sec)0
-rw-r--r--tests/keys/rsa.pub (renamed from tests/rsa.key)0
-rw-r--r--tests/keys/signing-key.pub (renamed from tests/signing-key.pub)0
-rw-r--r--tests/keys/signing-key.sec (renamed from tests/signing-key.sec)0
-rw-r--r--tests/minetest.scm7
-rw-r--r--tests/modules.scm6
-rw-r--r--tests/openpgp.scm40
-rw-r--r--tests/publish.scm9
-rw-r--r--tests/style.scm162
-rw-r--r--tests/texlive.scm14
-rw-r--r--tests/transformations.scm35
-rw-r--r--tests/upstream.scm166
29 files changed, 679 insertions, 91 deletions
diff --git a/tests/build-utils.scm b/tests/build-utils.scm
index 6b131c0af8..7f4f12ccc7 100644
--- a/tests/build-utils.scm
+++ b/tests/build-utils.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -167,9 +168,7 @@ echo hello world"))
"/some/path:/some/other/path"))))
'(let ((cl (command-line)))
(apply execl "/anything/cabbage-bash-1.2.3/bin/sh"
- (car cl)
- (cons (car cl)
- (append '("") cl)))))
+ (car cl) (append (quote ()) cl))))
script-contents)
(call-with-temporary-directory
(lambda (directory)
@@ -208,8 +207,7 @@ print('hello world')"))
`(let ((cl (command-line)))
(apply execl "/anything/cabbage-bash-1.2.3/bin/python3"
(car cl)
- (cons (car cl)
- (append '("" "-and" "-args") cl)))))
+ (append '("-and" "-args") cl))))
script-contents)
(call-with-temporary-directory
(lambda (directory)
@@ -243,6 +241,54 @@ print('hello world')"))
"/some/other/path")))
#f)))))
+(define (arg-test bash-args)
+ (call-with-temporary-directory
+ (lambda (directory)
+ (let ((script-file-name (string-append directory "/bash-test.sh")))
+ (call-with-output-file script-file-name
+ (lambda (port)
+ (display (string-append "\
+#!" (which "bash") bash-args "
+echo \"$#$0$*${A}\"")
+ port)))
+
+ (display "Unwrapped script contents:\n")
+ (call-with-input-file script-file-name
+ (lambda (port) (display (get-string-all port))))
+ (newline) (newline)
+ (chmod script-file-name #o777)
+ (setenv "A" "A")
+ (let* ((run-script (lambda _
+ (open-pipe*
+ OPEN_READ
+ script-file-name "1" "2" "3 3" "4")))
+ (pipe (run-script))
+ (unwrapped-output (get-string-all pipe)))
+ (close-pipe pipe)
+
+ (wrap-script script-file-name `("A" = ("A\nA")))
+
+ (display "Wrapped script contents:\n")
+ (call-with-input-file script-file-name
+ (lambda (port) (display (get-string-all port))))
+ (newline) (newline)
+
+ (let* ((pipe (run-script))
+ (wrapped-output (get-string-all pipe)))
+ (close-pipe pipe)
+ (display "./bash-test.sh 1 2 3\\ 3 4 # Output:\n")
+ (display unwrapped-output) (newline)
+ (display "./bash-test.sh 1 2 3\\ 3 4 # Output (wrapped):\n")
+ (display wrapped-output) (newline)
+ (string=? (string-append unwrapped-output "A\n")
+ wrapped-output)))))))
+
+(test-assert "wrap-script, argument handling"
+ (arg-test ""))
+
+(test-assert "wrap-script, argument handling, bash --norc"
+ (arg-test " --norc"))
+
(test-equal "substitute*, text contains a NUL byte, UTF-8"
"c\0d"
(with-fluids ((%default-port-encoding "UTF-8")
@@ -287,5 +333,4 @@ print('hello world')"))
("guile/bin" . ,(dirname (which "guile"))))
"guile"))))
-
(test-end)
diff --git a/tests/channels.scm b/tests/channels.scm
index 3e82315b0c..d45c450241 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -480,8 +480,8 @@
#t
(with-fresh-gnupg-setup (list %ed25519-public-key-file
%ed25519-secret-key-file
- %ed25519bis-public-key-file
- %ed25519bis-secret-key-file)
+ %ed25519-2-public-key-file
+ %ed25519-2-secret-key-file)
(with-temporary-git-repository directory
`((add ".guix-channel"
,(object->string
@@ -507,7 +507,7 @@
(commit-id-string commit1)
(openpgp-public-key-fingerprint
(read-openpgp-packet
- %ed25519bis-public-key-file)))) ;different key
+ %ed25519-2-public-key-file)))) ;different key
(channel (channel (name 'example)
(url (string-append "file://" directory))
(introduction intro))))
@@ -519,7 +519,7 @@
(oid->string (commit-id commit1))
(key-fingerprint %ed25519-public-key-file)
(key-fingerprint
- %ed25519bis-public-key-file))))))
+ %ed25519-2-public-key-file))))))
(authenticate-channel channel directory
(commit-id-string commit2)
#:keyring-reference-prefix "")
@@ -530,8 +530,8 @@
#t
(with-fresh-gnupg-setup (list %ed25519-public-key-file
%ed25519-secret-key-file
- %ed25519bis-public-key-file
- %ed25519bis-secret-key-file)
+ %ed25519-2-public-key-file
+ %ed25519-2-secret-key-file)
(with-temporary-git-repository directory
`((add ".guix-channel"
,(object->string
@@ -552,12 +552,12 @@
(signer ,(key-fingerprint %ed25519-public-key-file)))
(add "c.txt" "C")
(commit "third commit"
- (signer ,(key-fingerprint %ed25519bis-public-key-file)))
+ (signer ,(key-fingerprint %ed25519-2-public-key-file)))
(branch "channel-keyring")
(checkout "channel-keyring")
(add "signer.key" ,(call-with-input-file %ed25519-public-key-file
get-string-all))
- (add "other.key" ,(call-with-input-file %ed25519bis-public-key-file
+ (add "other.key" ,(call-with-input-file %ed25519-2-public-key-file
get-string-all))
(commit "keyring commit")
(checkout "master"))
@@ -588,7 +588,7 @@
(unauthorized-commit-error-signing-key c))
(openpgp-public-key-fingerprint
(read-openpgp-packet
- %ed25519bis-public-key-file))))))
+ %ed25519-2-public-key-file))))))
(authenticate-channel channel directory
(commit-id-string commit3)
#:keyring-reference-prefix "")
diff --git a/tests/git-authenticate.scm b/tests/git-authenticate.scm
index d87eacc659..f66ef191b0 100644
--- a/tests/git-authenticate.scm
+++ b/tests/git-authenticate.scm
@@ -161,14 +161,14 @@
(test-assert "signed commits, .guix-authorizations, unauthorized merge"
(with-fresh-gnupg-setup (list %ed25519-public-key-file
%ed25519-secret-key-file
- %ed25519bis-public-key-file
- %ed25519bis-secret-key-file)
+ %ed25519-2-public-key-file
+ %ed25519-2-secret-key-file)
(with-temporary-git-repository directory
`((add "signer1.key"
,(call-with-input-file %ed25519-public-key-file
get-string-all))
(add "signer2.key"
- ,(call-with-input-file %ed25519bis-public-key-file
+ ,(call-with-input-file %ed25519-2-public-key-file
get-string-all))
(add ".guix-authorizations"
,(object->string
@@ -184,7 +184,7 @@
(checkout "devel")
(add "devel/1.txt" "1")
(commit "first devel commit"
- (signer ,(key-fingerprint %ed25519bis-public-key-file)))
+ (signer ,(key-fingerprint %ed25519-2-public-key-file)))
(checkout "master")
(add "b.txt" "B")
(commit "second commit"
@@ -203,7 +203,7 @@
(openpgp-public-key-fingerprint
(unauthorized-commit-error-signing-key c))
(openpgp-public-key-fingerprint
- (read-openpgp-packet %ed25519bis-public-key-file)))))
+ (read-openpgp-packet %ed25519-2-public-key-file)))))
(and (authenticate-commits repository (list master1 master2)
#:keyring-reference "master")
@@ -230,14 +230,14 @@
(test-assert "signed commits, .guix-authorizations, authorized merge"
(with-fresh-gnupg-setup (list %ed25519-public-key-file
%ed25519-secret-key-file
- %ed25519bis-public-key-file
- %ed25519bis-secret-key-file)
+ %ed25519-2-public-key-file
+ %ed25519-2-secret-key-file)
(with-temporary-git-repository directory
`((add "signer1.key"
,(call-with-input-file %ed25519-public-key-file
get-string-all))
(add "signer2.key"
- ,(call-with-input-file %ed25519bis-public-key-file
+ ,(call-with-input-file %ed25519-2-public-key-file
get-string-all))
(add ".guix-authorizations"
,(object->string
@@ -258,12 +258,12 @@
%ed25519-public-key-file)
(name "Alice"))
(,(key-fingerprint
- %ed25519bis-public-key-file))))))
+ %ed25519-2-public-key-file))))))
(commit "first devel commit"
(signer ,(key-fingerprint %ed25519-public-key-file)))
(add "devel/2.txt" "2")
(commit "second devel commit"
- (signer ,(key-fingerprint %ed25519bis-public-key-file)))
+ (signer ,(key-fingerprint %ed25519-2-public-key-file)))
(checkout "master")
(add "b.txt" "B")
(commit "second commit"
@@ -273,7 +273,7 @@
;; After the merge, the second signer is authorized.
(add "c.txt" "C")
(commit "third commit"
- (signer ,(key-fingerprint %ed25519bis-public-key-file))))
+ (signer ,(key-fingerprint %ed25519-2-public-key-file))))
(with-repository directory repository
(let ((master1 (find-commit repository "first commit"))
(master2 (find-commit repository "second commit"))
@@ -328,4 +328,3 @@
'failed)))))))
(test-end "git-authenticate")
-
diff --git a/tests/gremlin.scm b/tests/gremlin.scm
index 9af899c89a..3dbb8d3643 100644
--- a/tests/gremlin.scm
+++ b/tests/gremlin.scm
@@ -1,5 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2018, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2022 Pierre Langlois <pierre.langlois@gmx.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -18,9 +20,12 @@
(define-module (test-gremlin)
#:use-module (guix elf)
- #:use-module ((guix utils) #:select (call-with-temporary-directory))
+ #:use-module (guix tests)
+ #:use-module ((guix utils) #:select (call-with-temporary-directory
+ target-aarch64?))
#:use-module (guix build utils)
#:use-module (guix build gremlin)
+ #:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
@@ -90,13 +95,26 @@
(if m
(loop (cons (match:substring m 2) result))
(loop result))))))
-
(define ground-truth
- (remove (cut string-prefix? "linux-vdso.so" <>)
+ (remove (lambda (entry)
+ ;; See vdso(7) for the list of vDSO names across
+ ;; architectures.
+ (or (string-prefix? "linux-vdso.so" entry)
+ (string-prefix? "linux-vdso32.so" entry) ;32-bit powerpc
+ (string-prefix? "linux-vdso64.so" entry) ;64-bit powerpc
+ (string-prefix? "linux-gate.so" entry) ;i386
+ ;; FIXME: ELF files on aarch64 do not always include a
+ ;; NEEDED entry for the dynamic linker, and it is unclear
+ ;; if that is OK. See: https://issues.guix.gnu.org/52943
+ (and (target-aarch64?)
+ (string-contains entry (glibc-dynamic-linker)))))
(read-ldd-output pipe)))
(and (zero? (close-pipe pipe))
- (lset= string=? (pk 'truth ground-truth) (pk 'needed needed)))))
+ ;; It's OK if file-needed/recursive returns multiple entries that are
+ ;; different strings referring to the same file. This appears to be a
+ ;; benign edge case. See: https://issues.guix.gnu.org/52940
+ (lset= file=? (pk 'truth ground-truth) (pk 'needed needed)))))
(test-equal "expand-origin"
'("OOO/../lib"
diff --git a/tests/guix-authenticate.sh b/tests/guix-authenticate.sh
index 3a05b232c1..0de6da1878 100644
--- a/tests/guix-authenticate.sh
+++ b/tests/guix-authenticate.sh
@@ -28,7 +28,7 @@ rm -f "$sig" "$hash"
trap 'rm -f "$sig" "$hash"' EXIT
-key="$abs_top_srcdir/tests/signing-key.sec"
+key="$abs_top_srcdir/tests/keys/signing-key.sec"
key_len="`echo -n $key | wc -c`"
# A hexadecimal string as long as a sha256 hash.
@@ -67,7 +67,7 @@ test "$code" -ne 0
# encoded independently of the current locale: <https://bugs.gnu.org/43421>.
hash="636166e9636166e9636166e9636166e9636166e9636166e9636166e9636166e9"
latin1_cafe="caf$(printf '\351')"
-echo "sign 21:tests/signing-key.sec 64:$hash" | guix authenticate \
+echo "sign 26:tests/keys/signing-key.sec 64:$hash" | guix authenticate \
| LC_ALL=C grep "hash sha256 \"$latin1_cafe"
# Test for <http://bugs.gnu.org/17312>: make sure 'guix authenticate' produces
diff --git a/tests/guix-graph.sh b/tests/guix-graph.sh
index 666660ab4b..e813e01c31 100644
--- a/tests/guix-graph.sh
+++ b/tests/guix-graph.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2015, 2016, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2015-2016, 2019-2020, 2022 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
#
# This file is part of GNU Guix.
@@ -23,11 +23,10 @@
module_dir="t-guix-graph-$$"
mkdir "$module_dir"
-trap "rm -rf $module_dir" EXIT
tmpfile1="$module_dir/t-guix-graph1-$$"
tmpfile2="$module_dir/t-guix-graph2-$$"
-trap 'rm -f "$tmpfile1" "$tmpfile2"' EXIT
+trap 'rm -r "$module_dir"' EXIT
cat > "$module_dir/foo.scm"<<EOF
diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh
index 854c493514..8b03c7985d 100644
--- a/tests/guix-hash.sh
+++ b/tests/guix-hash.sh
@@ -53,6 +53,7 @@ mkdir "$tmpdir/subdir"
test `guix hash -S nar "$tmpdir"` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
test `guix hash -S nar "$tmpdir" -H sha512` = 301ra58c2vahczzxiyfin41mpyb0ljh4dh9zn3ijvwviaw1j40sfzw5skh9x945da88n3785ggifzig7acd6k72h0mpsc20m1f66m9n
+test `guix hash -S git "$tmpdir"` = 1m9yxz99g7askm88h6hzyv4g2bfv57rp5wvwp3iq5ypsplq1xkkk
test `guix hash -S git "$tmpdir" -H sha512` = 158b10d1bsdk4pm8ym9cg9ckfak1b0cgpw7365cl6s341ir380mh2f4ylicyh8khyrfnwq5cn9766d7m8fbfwwl94ndkv456v6a8knr
# Deprecated --recursive option
@@ -76,7 +77,7 @@ test `guix hash -S git $tmpdir` = 0ghlpca9xaswa1ay1g55dknwd9q899mi3ahfr43pq083v8
# ...but remains the same when using `-x'
test `guix hash -S nar $tmpdir -x` = 10k1lw41wyrjf9mxydi0is5nkpynlsvgslinics4ppir13g7d74p
-test `guix hash -S git $tmpdir -x` = 0ghlpca9xaswa1ay1g55dknwd9q899mi3ahfr43pq083v8wisjc7
+test `guix hash -S git $tmpdir -x` = 1m9yxz99g7askm88h6hzyv4g2bfv57rp5wvwp3iq5ypsplq1xkkk
# Without '-r', this should fail.
! guix hash "$tmpdir"
diff --git a/tests/guix-package-net.sh b/tests/guix-package-net.sh
index 6d21c6cff6..1cdeff773a 100644
--- a/tests/guix-package-net.sh
+++ b/tests/guix-package-net.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012-2015, 2017, 2019, 2022 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
# Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
#
@@ -50,7 +50,10 @@ profile="t-profile-$$"
profile_alt="t-profile-alt-$$"
rm -f "$profile"
-trap 'rm -f "$profile" "$profile_alt" "$profile-"[0-9]* "$profile_alt-"[0-9]* ; rm -rf t-home-'"$$" EXIT
+module_dir="t-guix-package-net-$$"
+mkdir "$module_dir"
+
+trap 'rm -f "$profile" "$profile_alt" "$profile.lock" "$profile_alt.lock" "$profile-"[0-9]* "$profile_alt-"[0-9]* ; rm -r "$module_dir" t-home-'"$$" EXIT
guix package --bootstrap -p "$profile" -i guile-bootstrap
@@ -177,10 +180,6 @@ guix package -p "$profile" -p "$profile_alt" --search-paths \
| grep "LIBRARY_PATH.*$profile/lib.$profile_alt/lib"
# Simulate an upgrade and make sure the package order is preserved.
-module_dir="t-guix-package-net-$$"
-trap 'rm -rf "$module_dir"' EXIT
-
-mkdir "$module_dir"
cat > "$module_dir/new.scm" <<EOF
(define-module (new)
#:use-module (guix)
@@ -197,6 +196,16 @@ EOF
guix package --bootstrap -p "$profile" -i gcc-bootstrap
installed="`guix package -p "$profile" -I | cut -f1`"
+# Dry-run upgrade. Make sure no new generation is created when things are
+# already in store and '-n' is used: <https://issues.guix.gnu.org/53267>.
+V_MINOR=0
+export V_MINOR
+profile_before="$(readlink "$profile")"
+guix package -p "$profile" --bootstrap -L "$module_dir" -u # build the profile
+guix package -p "$profile" --roll-back
+guix package -p "$profile" --bootstrap -L "$module_dir" -u . -n # check '-n'
+test "$(readlink "$profile")" = "$profile_before"
+
for i in 1 2
do
V_MINOR="$i"
diff --git a/tests/home-import.scm b/tests/home-import.scm
index 0bcdf8a469..6d373acf79 100644
--- a/tests/home-import.scm
+++ b/tests/home-import.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2022 Arjan Adriaanse <arjan@adriaan.se>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -52,7 +53,8 @@
(define gcc
(manifest-entry
(name "gcc")
- (version "10.3.0")
+ (version "")
+ (output "lib")
(item "/gnu/store/...")))
;; Helpers for checking and generating home environments.
@@ -101,8 +103,8 @@ corresponding file."
('gnu 'services))
('home-environment
('packages
- ('map 'specification->package
- ('list "guile@2.0.9" "gcc" "glibc@2.19")))
+ ('map ('compose 'list 'specification->package+output)
+ ('list "guile@2.0.9" "gcc:lib" "glibc@2.19")))
('services
('list)))))
@@ -118,7 +120,7 @@ corresponding file."
('home-environment
('packages
('list (transform ('specification->package "guile@2.0.9"))
- ('specification->package "gcc")
+ ('list ('specification->package "gcc") "lib")
('specification->package "glibc@2.19")))
('services ('list)))))
@@ -130,7 +132,7 @@ corresponding file."
('gnu 'services))
('home-environment
('packages
- ('map 'specification->package
+ ('map ('compose 'list 'specification->package+output)
('list)))
('services
('list)))))
@@ -145,7 +147,7 @@ corresponding file."
('gnu 'home 'services 'shells))
('home-environment
('packages
- ('map 'specification->package
+ ('map ('compose 'list 'specification->package+output)
('list)))
('services
('list ('service
diff --git a/tests/import-github.scm b/tests/import-github.scm
new file mode 100644
index 0000000000..979a0fc12b
--- /dev/null
+++ b/tests/import-github.scm
@@ -0,0 +1,139 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 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-import-github)
+ #:use-module (json)
+ #:use-module (srfi srfi-35)
+ #:use-module (srfi srfi-64)
+ #:use-module (guix git-download)
+ #:use-module (guix http-client)
+ #:use-module (guix import github)
+ #:use-module (guix packages)
+ #:use-module (guix tests)
+ #:use-module (guix upstream)
+ #:use-module (ice-9 match))
+
+(test-begin "github")
+
+(define (call-with-releases thunk tags releases)
+ (mock ((guix http-client) http-fetch
+ (lambda* (uri #:key headers)
+ (unless (string-prefix? "mock://" uri)
+ (error "the URI ~a should not be used" uri))
+ (define components
+ (string-split (substring uri 8) #\/))
+ (pk 'stuff components headers)
+ (define (scm->json-port scm)
+ (open-input-string (scm->json-string scm)))
+ (match components
+ (("repos" "foo" "foomatics" "releases")
+ (scm->json-port releases))
+ (("repos" "foo" "foomatics" "tags")
+ (scm->json-port tags))
+ (rest (error "TODO ~a" rest)))))
+ (parameterize ((%github-api "mock://"))
+ (thunk))))
+
+;; Copied from tests/minetest.scm
+(define (upstream-source->sexp upstream-source)
+ (define url (upstream-source-urls upstream-source))
+ (unless (git-reference? url)
+ (error "a <git-reference> is expected"))
+ `(,(upstream-source-package upstream-source)
+ ,(upstream-source-version upstream-source)
+ ,(git-reference-url url)
+ ,(git-reference-commit url)))
+
+(define* (expected-sexp new-version new-commit)
+ `("foomatics" ,new-version "https://github.com/foo/foomatics" ,new-commit))
+
+(define (example-package old-version old-commit)
+ (package
+ (name "foomatics")
+ (version old-version)
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/foo/foomatics")
+ (commit old-commit)))
+ (sha256 #f) ; not important for following tests
+ (file-name (git-file-name name version))))
+ (build-system #f)
+ (license #f)
+ (synopsis #f)
+ (description #f)
+ (home-page #f)))
+
+(define* (found-sexp old-version old-commit tags releases)
+ (and=>
+ (call-with-releases (lambda ()
+ ((upstream-updater-latest %github-updater)
+ (example-package old-version old-commit)))
+ tags releases)
+ upstream-source->sexp))
+
+(define-syntax-rule (test-release test-case old-version
+ old-commit new-version new-commit
+ tags releases)
+ (test-equal test-case
+ (expected-sexp new-version new-commit)
+ (found-sexp old-version old-commit tags releases)))
+
+(test-release "newest release is choosen"
+ "1.0.0" "v1.0.0" "1.9" "v1.9"
+ #()
+ ;; a mixture of current, older and newer versions
+ #((("tag_name" . "v0.0"))
+ (("tag_name" . "v1.0.1"))
+ (("tag_name" . "v1.9"))
+ (("tag_name" . "v1.0.0"))
+ (("tag_name" . "v1.0.2"))))
+
+(test-release "tags are used when there are no formal releases"
+ "1.0.0" "v1.0.0" "1.9" "v1.9"
+ ;; a mixture of current, older and newer versions
+ #((("name" . "v0.0"))
+ (("name" . "v1.0.1"))
+ (("name" . "v1.9"))
+ (("name" . "v1.0.0"))
+ (("name" . "v1.0.2")))
+ #())
+
+(test-release "\"version-\" prefixes are recognised"
+ "1.0.0" "v1.0.0" "1.9" "version-1.9"
+ #((("name" . "version-1.9")))
+ #())
+
+(test-release "prefixes are optional"
+ "1.0.0" "v1.0.0" "1.9" "1.9"
+ #((("name" . "1.9")))
+ #())
+
+(test-release "prefixing by package name is acceptable"
+ "1.0.0" "v1.0.0" "1.9" "foomatics-1.9"
+ #((("name" . "foomatics-1.9")))
+ #())
+
+(test-release "not all prefixes are acceptable"
+ "1.0.0" "v1.0.0" "1.0.0" "v1.0.0"
+ #((("name" . "v1.0.0"))
+ (("name" . "barstatics-1.9")))
+ #())
+
+(test-end "github")
diff --git a/tests/civodul.key b/tests/keys/civodul.pub
index 272600ac93..272600ac93 100644
--- a/tests/civodul.key
+++ b/tests/keys/civodul.pub
diff --git a/tests/dsa.key b/tests/keys/dsa.pub
index 4727975c63..4727975c63 100644
--- a/tests/dsa.key
+++ b/tests/keys/dsa.pub
diff --git a/tests/ed25519bis.key b/tests/keys/ed25519-2.pub
index f5329105d5..f5329105d5 100644
--- a/tests/ed25519bis.key
+++ b/tests/keys/ed25519-2.pub
diff --git a/tests/ed25519bis.sec b/tests/keys/ed25519-2.sec
index 059765f557..059765f557 100644
--- a/tests/ed25519bis.sec
+++ b/tests/keys/ed25519-2.sec
diff --git a/tests/keys/ed25519-3.pub b/tests/keys/ed25519-3.pub
new file mode 100644
index 0000000000..72f311984c
--- /dev/null
+++ b/tests/keys/ed25519-3.pub
@@ -0,0 +1,9 @@
+-----BEGIN PGP PUBLIC KEY BLOCK-----
+
+mDMEYVH/7xYJKwYBBAHaRw8BAQdALMLeUhjEG2/UPCJj2j/debFwwAK5gT3G0l5d
+ILfFldm0FTxleGFtcGxlQGV4YW1wbGUuY29tPoiWBBMWCAA+FiEEjO6M85jMSK68
+7tINGBzA7NyoagkFAmFR/+8CGwMFCQPCZwAFCwkIBwIGFQoJCAsCBBYCAwECHgEC
+F4AACgkQGBzA7Nyoagl3lgEAw6yqIlX11lTqwxBGhZk/Oy34O13cbJSZCGv+m0ja
++hcA/3DCNOmT+oXjgO/w6enQZUQ1m/d6dUjCc2wOLlLz+ZoG
+=+r3i
+-----END PGP PUBLIC KEY BLOCK-----
diff --git a/tests/keys/ed25519-3.sec b/tests/keys/ed25519-3.sec
new file mode 100644
index 0000000000..04128a4131
--- /dev/null
+++ b/tests/keys/ed25519-3.sec
@@ -0,0 +1,10 @@
+-----BEGIN PGP PRIVATE KEY BLOCK-----
+
+lFgEYVH/7xYJKwYBBAHaRw8BAQdALMLeUhjEG2/UPCJj2j/debFwwAK5gT3G0l5d
+ILfFldkAAP92goSbbzQ0ttElr9lr5Cm6rmQtqUZ2Cu/Jk9fvfZROwxI0tBU8ZXhh
+bXBsZUBleGFtcGxlLmNvbT6IlgQTFggAPhYhBIzujPOYzEiuvO7SDRgcwOzcqGoJ
+BQJhUf/vAhsDBQkDwmcABQsJCAcCBhUKCQgLAgQWAgMBAh4BAheAAAoJEBgcwOzc
+qGoJd5YBAMOsqiJV9dZU6sMQRoWZPzst+Dtd3GyUmQhr/ptI2voXAP9wwjTpk/qF
+44Dv8Onp0GVENZv3enVIwnNsDi5S8/maBg==
+=EmOt
+-----END PGP PRIVATE KEY BLOCK-----
diff --git a/tests/ed25519.key b/tests/keys/ed25519.pub
index f6bf906783..f6bf906783 100644
--- a/tests/ed25519.key
+++ b/tests/keys/ed25519.pub
diff --git a/tests/ed25519.sec b/tests/keys/ed25519.sec
index 068738dfab..068738dfab 100644
--- a/tests/ed25519.sec
+++ b/tests/keys/ed25519.sec
diff --git a/tests/rsa.key b/tests/keys/rsa.pub
index 0ef9145ef0..0ef9145ef0 100644
--- a/tests/rsa.key
+++ b/tests/keys/rsa.pub
diff --git a/tests/signing-key.pub b/tests/keys/signing-key.pub
index 092424a15d..092424a15d 100644
--- a/tests/signing-key.pub
+++ b/tests/keys/signing-key.pub
diff --git a/tests/signing-key.sec b/tests/keys/signing-key.sec
index 558e189102..558e189102 100644
--- a/tests/signing-key.sec
+++ b/tests/keys/signing-key.sec
diff --git a/tests/minetest.scm b/tests/minetest.scm
index 77b9aa928f..cbb9e83889 100644
--- a/tests/minetest.scm
+++ b/tests/minetest.scm
@@ -387,10 +387,9 @@ during a dynamic extent where that package is available on ContentDB."
;; 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))
+ (define url (upstream-source-urls upstream-source))
+ (unless (git-reference? url)
+ (error "a <git-reference> is expected"))
`(,(upstream-source-package upstream-source)
,(upstream-source-version upstream-source)
,(git-reference-url url)
diff --git a/tests/modules.scm b/tests/modules.scm
index 57019c600c..e70d2d9e08 100644
--- a/tests/modules.scm
+++ b/tests/modules.scm
@@ -39,10 +39,10 @@
(live-module-closure '((gnu build install)))
(source-module-closure '((gnu build install)))))
-(test-assert "closure of (gnu build vm)"
+(test-assert "closure of (gnu build image)"
(lset= equal?
- (live-module-closure '((gnu build vm)))
- (source-module-closure '((gnu build vm)))))
+ (live-module-closure '((gnu build image)))
+ (source-module-closure '((gnu build image)))))
(test-equal "&missing-dependency-error"
'(something that does not exist)
diff --git a/tests/openpgp.scm b/tests/openpgp.scm
index c2be26fa49..1f20466772 100644
--- a/tests/openpgp.scm
+++ b/tests/openpgp.scm
@@ -59,18 +59,22 @@ vBSFjNSiVHsuAA==
(define %civodul-fingerprint
"3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5")
-(define %civodul-key-id #x090B11993D9AEBB5) ;civodul.key
+(define %civodul-key-id #x090B11993D9AEBB5) ;civodul.pub
-;; Test keys. They were generated in a container along these lines:
-;; guix environment -CP --ad-hoc gnupg pinentry
-;; then, within the container:
-;; mkdir ~/.gnupg
-;; echo pinentry-program ~/.guix-profile/bin/pinentry-tty > ~/.gnupg/gpg-agent.conf
-;; gpg --quick-gen-key '<ludo+test-rsa@chbouib.org>' rsa
-;; or similar.
-(define %rsa-key-id #xAE25DA2A70DEED59) ;rsa.key
-(define %dsa-key-id #x587918047BE8BD2C) ;dsa.key
-(define %ed25519-key-id #x771F49CBFAAE072D) ;ed25519.key
+#|
+Test keys in ./tests/keys. They were generated in a container along these lines:
+ guix environment -CP --ad-hoc gnupg pinentry coreutils
+then, within the container:
+ mkdir ~/.gnupg && chmod -R og-rwx ~/.gnupg
+ gpg --batch --passphrase '' --quick-gen-key '<example@example.com>' ed25519
+ gpg --armor --export example@example.com
+ gpg --armor --export-secret-key example@example.com
+ # echo pinentry-program ~/.guix-profile/bin/pinentry-curses > ~/.gnupg/gpg-agent.conf
+or similar.
+|#
+(define %rsa-key-id #xAE25DA2A70DEED59) ;rsa.pub
+(define %dsa-key-id #x587918047BE8BD2C) ;dsa.pub
+(define %ed25519-key-id #x771F49CBFAAE072D) ;ed25519.pub
(define %rsa-key-fingerprint
(base16-string->bytevector
@@ -168,7 +172,7 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0=
(not (port-ascii-armored? (open-bytevector-input-port %binary-sample))))
(test-assert "get-openpgp-keyring"
- (let* ((key (search-path %load-path "tests/civodul.key"))
+ (let* ((key (search-path %load-path "tests/keys/civodul.pub"))
(keyring (get-openpgp-keyring
(open-bytevector-input-port
(call-with-input-file key read-radix-64)))))
@@ -228,8 +232,10 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0=
(verify-openpgp-signature signature keyring
(open-input-string "Hello!\n"))))
(list status (openpgp-public-key-id key)))))
- (list "tests/rsa.key" "tests/dsa.key"
- "tests/ed25519.key" "tests/ed25519.key" "tests/ed25519.key")
+ (list "tests/keys/rsa.pub" "tests/keys/dsa.pub"
+ "tests/keys/ed25519.pub"
+ "tests/keys/ed25519.pub"
+ "tests/keys/ed25519.pub")
(list %hello-signature/rsa %hello-signature/dsa
%hello-signature/ed25519/sha256
%hello-signature/ed25519/sha512
@@ -248,9 +254,9 @@ Pz7oopeN72xgggYUNT37ezqN3MeCqw0=
(call-with-input-file key read-radix-64))
keyring)))
%empty-keyring
- '("tests/rsa.key" "tests/dsa.key"
- "tests/ed25519.key" "tests/ed25519.key"
- "tests/ed25519.key"))))
+ '("tests/keys/rsa.pub" "tests/keys/dsa.pub"
+ "tests/keys/ed25519.pub" "tests/keys/ed25519.pub"
+ "tests/keys/ed25519.pub"))))
(map (lambda (signature)
(let ((signature (string->openpgp-packet signature)))
(let-values (((status key)
diff --git a/tests/publish.scm b/tests/publish.scm
index c3d086995a..e3c27c5eea 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2020 by Amar M. Singh <nly@disroot.org>
-;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -679,7 +679,7 @@ References: ~%"
(response-code (http-get nar)))))))))
(test-equal "/log/NAME"
- `(200 #t application/x-bzip2)
+ `(200 #t text/plain (gzip))
(let ((drv (run-with-store %store
(gexp->derivation "with-log"
#~(call-with-output-file #$output
@@ -695,10 +695,11 @@ References: ~%"
(base (basename (derivation-file-name drv)))
(log (string-append (dirname %state-directory)
"/log/guix/drvs/" (string-take base 2)
- "/" (string-drop base 2) ".bz2")))
+ "/" (string-drop base 2) ".gz")))
(list (response-code response)
(= (response-content-length response) (stat:size (stat log)))
- (first (response-content-type response))))))
+ (first (response-content-type response))
+ (response-content-encoding response)))))
(test-equal "negative TTL"
`(404 42)
diff --git a/tests/style.scm b/tests/style.scm
index ada9197fc1..8c6d37a661 100644
--- a/tests/style.scm
+++ b/tests/style.scm
@@ -21,6 +21,7 @@
#:use-module (guix scripts style)
#:use-module ((guix utils) #:select (call-with-temporary-directory))
#:use-module ((guix build utils) #:select (substitute*))
+ #:use-module (guix gexp) ;for the reader extension
#:use-module (guix diagnostics)
#:use-module (gnu packages acl)
#:use-module (gnu packages multiprecision)
@@ -77,7 +78,8 @@
(string-append directory "/my-packages.scm"))
;; Run as a separate process to make sure FILE is reloaded.
- (system* "guix" "style" "-L" directory "my-coreutils")
+ (system* "guix" "style" "-L" directory "-S" "inputs"
+ "my-coreutils")
(system* "cat" file)
(load file)
@@ -111,6 +113,17 @@
(lambda (port)
(read-lines port line count)))))
+(define-syntax-rule (test-pretty-print str args ...)
+ "Test equality after a round-trip where STR is passed to
+'read-with-comments' and the resulting sexp is then passed to
+'pretty-print-with-comments'."
+ (test-equal str
+ (call-with-output-string
+ (lambda (port)
+ (let ((exp (call-with-input-string str
+ read-with-comments)))
+ (pretty-print-with-comments port exp args ...))))))
+
(test-begin "style")
@@ -225,6 +238,7 @@
(string-append directory "/my-packages.scm"))
(system* "guix" "style" "-L" directory "my-coreutils"
+ "-S" "inputs"
"--input-simplification=safe")
(load file)
@@ -246,6 +260,7 @@
(string-append directory "/my-packages.scm"))
(system* "guix" "style" "-L" directory "my-coreutils"
+ "-S" "inputs"
"--input-simplification=safe")
(load file)
@@ -272,7 +287,8 @@
" ;another one\n")))
(system* "cat" file)
- (system* "guix" "style" "-L" directory "my-coreutils")
+ (system* "guix" "style" "-L" directory "-S" "inputs"
+ "my-coreutils")
(load file)
(list (package-inputs (@ (my-packages) my-coreutils))
@@ -305,7 +321,8 @@
" ;margin comment\n")))
(system* "cat" file)
- (system* "guix" "style" "-L" directory "my-coreutils")
+ (system* "guix" "style" "-L" directory "-S" "inputs"
+ "my-coreutils")
(load file)
(list (package-inputs (@ (my-packages) my-coreutils))
@@ -326,7 +343,8 @@
((",gmp\\)(.*)$" _ rest)
(string-append ",gmp)\n ;; line comment!\n" rest)))
- (system* "guix" "style" "-L" directory "my-coreutils")
+ (system* "guix" "style" "-L" directory "-S" "inputs"
+ "my-coreutils")
(load file)
(list (package-inputs (@ (my-packages) my-coreutils))
@@ -352,12 +370,146 @@
((",acl\\)(.*)$" _ rest)
(string-append ",acl) ;another one\n" rest)))
- (system* "guix" "style" "-L" directory "my-coreutils")
+ (system* "guix" "style" "-L" directory "-S" "inputs"
+ "my-coreutils")
(load file)
(list (package-inputs (@ (my-packages) my-coreutils))
(read-package-field (@ (my-packages) my-coreutils) 'inputs 4)))))
+(test-pretty-print "(list 1 2 3 4)")
+(test-pretty-print "(list 1
+ 2
+ 3
+ 4)"
+ #:long-list 3
+ #:indent 20)
+(test-pretty-print "\
+(list abc
+ def)"
+ #:max-width 11)
+(test-pretty-print "\
+(#:foo
+ #:bar)"
+ #:max-width 10)
+
+(test-pretty-print "\
+(#:first 1
+ #:second 2
+ #:third 3)")
+
+(test-pretty-print "\
+((x
+ 1)
+ (y
+ 2)
+ (z
+ 3))"
+ #:max-width 3)
+
+(test-pretty-print "\
+(let ((x 1)
+ (y 2)
+ (z 3)
+ (p 4))
+ (+ x y))"
+ #:max-width 11)
+
+(test-pretty-print "\
+(lambda (x y)
+ ;; This is a procedure.
+ (let ((z (+ x y)))
+ (* z z)))")
+
+(test-pretty-print "\
+#~(string-append #$coreutils \"/bin/uname\")")
+
+(test-pretty-print "\
+(package
+ (inherit coreutils)
+ (version \"42\"))")
+
+(test-pretty-print "\
+(modify-phases %standard-phases
+ (add-after 'unpack 'post-unpack
+ (lambda _
+ #t))
+ (add-before 'check 'pre-check
+ (lambda* (#:key inputs #:allow-other-keys)
+ do things ...)))")
+
+(test-pretty-print "\
+(#:phases (modify-phases sdfsdf
+ (add-before 'x 'y
+ (lambda _
+ xyz))))")
+
+(test-pretty-print "\
+(description \"abcdefghijkl
+mnopqrstuvwxyz.\")"
+ #:max-width 30)
+
+(test-pretty-print "\
+(description
+ \"abcdefghijkl
+mnopqrstuvwxyz.\")"
+ #:max-width 12)
+
+(test-pretty-print "\
+(description
+ \"abcdefghijklmnopqrstuvwxyz\")"
+ #:max-width 33)
+
+(test-pretty-print "\
+(modify-phases %standard-phases
+ (replace 'build
+ ;; Nicely indented in 'modify-phases' context.
+ (lambda _
+ #t)))")
+
+(test-pretty-print "\
+(modify-inputs inputs
+ ;; Regular indentation for 'replace' here.
+ (replace \"gmp\" gmp))")
+
+(test-pretty-print "\
+(package
+ ;; Here 'sha256', 'base32', and 'arguments' must be
+ ;; immediately followed by a newline.
+ (source (origin
+ (method url-fetch)
+ (sha256
+ (base32
+ \"not a real base32 string\"))))
+ (arguments
+ '(#:phases %standard-phases
+ #:tests? #f)))")
+
+(test-equal "pretty-print-with-comments, canonicalize-comment"
+ "\
+(list abc
+ ;; Not a margin comment.
+ ;; Ditto.
+ ;;
+ ;; There's a blank line above.
+ def ;margin comment
+ ghi)"
+ (let ((sexp (call-with-input-string
+ "\
+(list abc
+ ;Not a margin comment.
+ ;;; Ditto.
+ ;;;;;
+ ; There's a blank line above.
+ def ;; margin comment
+ ghi)"
+ read-with-comments)))
+ (call-with-output-string
+ (lambda (port)
+ (pretty-print-with-comments port sexp
+ #:format-comment
+ canonicalize-comment)))))
+
(test-end)
;; Local Variables:
diff --git a/tests/texlive.scm b/tests/texlive.scm
index 368e36e31a..f718e3a0a0 100644
--- a/tests/texlive.scm
+++ b/tests/texlive.scm
@@ -177,19 +177,19 @@ completely compatible with Plain TeX.")
(('package
('inherit ('simple-texlive-package
"texlive-texsis"
- ('list "doc/man/man1/"
+ ('list "bibtex/bst/texsis/"
+ "doc/man/man1/"
"doc/otherformats/texsis/base/"
- "bibtex/bst/texsis/"
"tex/texsis/base/"
"tex/texsis/config/")
('base32 (? string? hash))
#:trivial? #t))
('propagated-inputs
- (("texlive-cm" ',texlive-cm)
- ("texlive-hyphen-base" ',texlive-hyphen-base)
- ("texlive-knuth-lib" ',texlive-knuth-lib)
- ("texlive-plain" ',texlive-plain)
- ("texlive-tex" ',texlive-tex)))
+ ('list 'texlive-cm
+ 'texlive-hyphen-base
+ 'texlive-knuth-lib
+ 'texlive-plain
+ 'texlive-tex))
('home-page "https://www.tug.org/texlive/")
('synopsis "Plain TeX macros for Physicists")
('description (? string? description))
diff --git a/tests/transformations.scm b/tests/transformations.scm
index 09839dc1c5..8db85b4305 100644
--- a/tests/transformations.scm
+++ b/tests/transformations.scm
@@ -38,12 +38,14 @@
#:use-module (guix utils)
#:use-module (guix git)
#:use-module (guix upstream)
+ #:use-module (guix diagnostics)
#:use-module (gnu packages)
#:use-module (gnu packages base)
#:use-module (gnu packages busybox)
#: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))
@@ -465,6 +467,39 @@
`((with-latest . "foo")))))
(package-version (t p)))))
+(test-equal "options->transformation, tune"
+ '(cpu-tuning . "superfast")
+ (let* ((p0 (dummy-package "p0"))
+ (p1 (dummy-package "p1"
+ (inputs `(("p0" ,p0)))
+ (properties '((tunable? . #t)))))
+ (p2 (dummy-package "p2"
+ (inputs `(("p1" ,p1)))))
+ (t (options->transformation '((tune . "superfast"))))
+ (p3 (t p2)))
+ (and (not (package-replacement p3))
+ (match (package-inputs p3)
+ ((("p1" tuned))
+ (match (package-inputs tuned)
+ ((("p0" p0))
+ (and (not (package-replacement p0))
+ (assq 'cpu-tuning
+ (package-properties
+ (package-replacement tuned)))))))))))
+
+(test-assert "options->transformations, tune, wrong micro-architecture"
+ (let ((p (dummy-package "tunable"
+ (properties '((tunable? . #t)))))
+ (t (options->transformation '((tune . "nonexistent-superfast")))))
+ ;; Because GCC used by P's build system does not support
+ ;; '-march=nonexistent-superfast', we should see an error when lowering
+ ;; the tuned package.
+ (guard (c ((formatted-message? c)
+ (member "nonexistent-superfast"
+ (formatted-message-arguments c))))
+ (package->bag (t p))
+ #f)))
+
(test-equal "options->transformation + package->manifest-entry"
'((transformations . ((without-tests . "foo"))))
(let* ((p (dummy-package "foo"))
diff --git a/tests/upstream.scm b/tests/upstream.scm
index e431956960..9aacb77229 100644
--- a/tests/upstream.scm
+++ b/tests/upstream.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,9 +18,16 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-upstream)
+ #:use-module (gnu packages base)
+ #:use-module (guix download)
+ #:use-module (guix packages)
+ #:use-module (guix build-system gnu)
+ #:use-module (guix import print)
+ #:use-module ((guix licenses) #:prefix license:)
#:use-module (guix upstream)
#:use-module (guix tests)
- #:use-module (srfi srfi-64))
+ #:use-module (srfi srfi-64)
+ #:use-module (ice-9 match))
(test-begin "upstream")
@@ -46,4 +54,160 @@
(signature-urls
'("ftp://example.org/foo-1.tar.xz.sig"))))))
+(define test-package
+ (package
+ (name "test")
+ (version "2.10")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/hello/hello-" version
+ ".tar.gz"))
+ (sha256
+ (base32
+ "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
+ (build-system gnu-build-system)
+ (inputs
+ `(("hello" ,hello)))
+ (native-inputs
+ `(("sed" ,sed)
+ ("tar" ,tar)))
+ (propagated-inputs
+ `(("grep" ,grep)))
+ (home-page "http://localhost")
+ (synopsis "test")
+ (description "test")
+ (license license:gpl3+)))
+
+(define test-package-sexp
+ '(package
+ (name "test")
+ (version "2.10")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/hello/hello-" version
+ ".tar.gz"))
+ (sha256
+ (base32
+ "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
+ (build-system gnu-build-system)
+ (inputs
+ `(("hello" ,hello)))
+ (native-inputs
+ `(("sed" ,sed)
+ ("tar" ,tar)))
+ (propagated-inputs
+ `(("grep" ,grep)))
+ (home-page "http://localhost")
+ (synopsis "test")
+ (description "test")
+ (license license:gpl3+)))
+
+(test-equal "changed-inputs returns no changes"
+ '()
+ (changed-inputs test-package test-package-sexp))
+
+(test-assert "changed-inputs returns changes to labelled input list"
+ (let ((changes (changed-inputs
+ (package
+ (inherit test-package)
+ (inputs `(("hello" ,hello)
+ ("sed" ,sed))))
+ test-package-sexp)))
+ (match changes
+ ;; Exactly one change
+ (((? upstream-input-change? item))
+ (and (equal? (upstream-input-change-type item)
+ 'regular)
+ (equal? (upstream-input-change-action item)
+ 'remove)
+ (string=? (upstream-input-change-name item)
+ "sed")))
+ (else (pk else #false)))))
+
+(test-assert "changed-inputs returns changes to all labelled input lists"
+ (let ((changes (changed-inputs
+ (package
+ (inherit test-package)
+ (inputs '())
+ (native-inputs '())
+ (propagated-inputs '()))
+ test-package-sexp)))
+ (match changes
+ (((? upstream-input-change? items) ...)
+ (and (equal? (map upstream-input-change-type items)
+ '(regular native native propagated))
+ (equal? (map upstream-input-change-action items)
+ '(add add add add))
+ (equal? (map upstream-input-change-name items)
+ '("hello" "sed" "tar" "grep"))))
+ (else (pk else #false)))))
+
+(define test-new-package
+ (package
+ (inherit test-package)
+ (inputs
+ (list hello))
+ (native-inputs
+ (list sed tar))
+ (propagated-inputs
+ (list grep))))
+
+(define test-new-package-sexp
+ '(package
+ (name "test")
+ (version "2.10")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/hello/hello-" version
+ ".tar.gz"))
+ (sha256
+ (base32
+ "0ssi1wpaf7plaswqqjwigppsg5fyh99vdlb9kzl7c9lng89ndq1i"))))
+ (build-system gnu-build-system)
+ (inputs
+ (list hello))
+ (native-inputs
+ (list sed tar))
+ (propagated-inputs
+ (list grep))
+ (home-page "http://localhost")
+ (synopsis "test")
+ (description "test")
+ (license license:gpl3+)))
+
+(test-assert "changed-inputs returns changes to plain input list"
+ (let ((changes (changed-inputs
+ (package
+ (inherit test-new-package)
+ (inputs (list hello sed)))
+ test-new-package-sexp)))
+ (match changes
+ ;; Exactly one change
+ (((? upstream-input-change? item))
+ (and (equal? (upstream-input-change-type item)
+ 'regular)
+ (equal? (upstream-input-change-action item)
+ 'remove)
+ (string=? (upstream-input-change-name item)
+ "sed")))
+ (else (pk else #false)))))
+
+(test-assert "changed-inputs returns changes to all plain input lists"
+ (let ((changes (changed-inputs
+ (package
+ (inherit test-new-package)
+ (inputs '())
+ (native-inputs '())
+ (propagated-inputs '()))
+ test-new-package-sexp)))
+ (match changes
+ (((? upstream-input-change? items) ...)
+ (and (equal? (map upstream-input-change-type items)
+ '(regular native native propagated))
+ (equal? (map upstream-input-change-action items)
+ '(add add add add))
+ (equal? (map upstream-input-change-name items)
+ '("hello" "sed" "tar" "grep"))))
+ (else (pk else #false)))))
+
(test-end)
generated by cgit v1.2.3 (git 2.50.1) at 2025-08-08 08:57:19 +0000