summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/cpan.scm63
-rw-r--r--tests/elpa.scm76
-rw-r--r--tests/gem.scm245
-rw-r--r--tests/guix-refresh.sh8
-rw-r--r--tests/hexpm.scm126
-rw-r--r--tests/opam.scm33
-rw-r--r--tests/pypi.scm469
-rw-r--r--tests/services.scm83
-rw-r--r--tests/substitute.scm36
-rw-r--r--tests/texlive.scm38
-rw-r--r--tests/upstream.scm197
11 files changed, 714 insertions, 660 deletions
diff --git a/tests/cpan.scm b/tests/cpan.scm
index bbcd108e12..e4ee788e9d 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
-;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,7 +21,10 @@
(define-module (test-cpan)
#:use-module (guix import cpan)
#:use-module (guix base32)
+ #:use-module (guix upstream)
+ #:use-module ((guix download) #:select (url-fetch))
#:use-module (gcrypt hash)
+ #:use-module (guix tests)
#:use-module (guix tests http)
#:use-module ((guix store) #:select (%graft?))
#:use-module (srfi srfi-64)
@@ -64,37 +67,57 @@
(test-begin "cpan")
(test-assert "cpan->guix-package"
- ;; Replace network resources with sample data.
(with-http-server `((200 ,test-json)
(200 ,test-source)
(200 "{ \"distribution\" : \"Test-Script\" }"))
(parameterize ((%metacpan-base-url (%local-url))
(current-http-proxy (%local-url)))
(match (cpan->guix-package "Foo::Bar")
- (('package
- ('name "perl-foo-bar")
- ('version "0.1")
- ('source ('origin
- ('method 'url-fetch)
- ('uri ('string-append "http://example.com/Foo-Bar-"
- 'version ".tar.gz"))
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'perl-build-system)
- ('propagated-inputs
- ('quasiquote
- (("perl-test-script" ('unquote 'perl-test-script)))))
- ('home-page "https://metacpan.org/release/Foo-Bar")
- ('synopsis "Fizzle Fuzz")
- ('description 'fill-in-yourself!)
- ('license 'perl-license))
+ (`(package
+ (name "perl-foo-bar")
+ (version "0.1")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "http://example.com/Foo-Bar-"
+ version ".tar.gz"))
+ (sha256
+ (base32 ,(? string? hash)))))
+ (build-system perl-build-system)
+ (propagated-inputs (list perl-test-script))
+ (home-page "https://metacpan.org/release/Foo-Bar")
+ (synopsis "Fizzle Fuzz")
+ (description fill-in-yourself!)
+ (license perl-license))
(string=? (bytevector->nix-base32-string
(call-with-input-string test-source port-sha256))
hash))
(x
(pk 'fail x #f))))))
+(test-equal "package-latest-release"
+ (list '("http://example.com/Foo-Bar-0.1.tar.gz")
+ #f
+ (list (upstream-input
+ (name "Test-Script")
+ (downstream-name "perl-test-script")
+ (type 'propagated))))
+ (with-http-server `((200 ,test-json)
+ (200 ,test-source)
+ (200 "{ \"distribution\" : \"Test-Script\" }"))
+ (define source
+ (parameterize ((%metacpan-base-url (%local-url)))
+ (package-latest-release
+ (dummy-package "perl-test-script"
+ (version "0.0.0")
+ (source (dummy-origin
+ (method url-fetch)
+ (uri "mirror://cpan/Foo-Bar-0.0.0.tgz"))))
+ (list %cpan-updater))))
+
+ (list (upstream-source-urls source)
+ (upstream-source-signature-urls source)
+ (upstream-source-inputs source))))
+
(test-equal "metacpan-url->mirror-url, http"
"mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"
(metacpan-url->mirror-url
diff --git a/tests/elpa.scm b/tests/elpa.scm
index 1efdf2457f..f6d008cd09 100644
--- a/tests/elpa.scm
+++ b/tests/elpa.scm
@@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
-;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;;
@@ -21,6 +21,8 @@
(define-module (test-elpa)
#:use-module (guix import elpa)
+ #:use-module (guix upstream)
+ #:use-module ((guix download) #:select (url-fetch))
#:use-module (guix tests)
#:use-module (guix tests http)
#:use-module (srfi srfi-1)
@@ -40,8 +42,20 @@
(auctex .
[(11 88 6)
nil "Integrated environment for *TeX*" tar
- ((:url . "http://www.gnu.org/software/auctex/"))])))
+ ((:url . "http://www.gnu.org/software/auctex/"))])
+ (taxy-magit-section .
+ [(0 12 2)
+ ((emacs
+ (26 3))
+ (magit-section
+ (3 2 1))
+ (taxy
+ (0 10)))
+ "View Taxy structs in a Magit Section buffer" tar
+ ((:url . "https://github.com/alphapapa/taxy.el")
+ (:keywords "lisp"))])))
+
(test-begin "elpa")
(define (eval-test-with-elpa pkg)
@@ -52,20 +66,20 @@
(200 "fake tarball contents"))
(parameterize ((current-http-proxy (%local-url)))
(match (elpa->guix-package pkg #:repo 'gnu/http)
- (('package
- ('name "emacs-auctex")
- ('version "11.88.6")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('string-append
- "http://elpa.gnu.org/packages/auctex-" 'version ".tar"))
- ('sha256 ('base32 (? string? hash)))))
- ('build-system 'emacs-build-system)
- ('home-page "http://www.gnu.org/software/auctex/")
- ('synopsis "Integrated environment for *TeX*")
- ('description "This is the description.")
- ('license 'license:gpl3+))
+ (`(package
+ (name "emacs-auctex")
+ (version "11.88.6")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append
+ "http://elpa.gnu.org/packages/auctex-" version ".tar"))
+ (sha256 (base32 ,(? string? hash)))))
+ (build-system emacs-build-system)
+ (home-page "http://www.gnu.org/software/auctex/")
+ (synopsis "Integrated environment for *TeX*")
+ (description "This is the description.")
+ (license license:gpl3+))
#t)
(x
(pk 'fail x #f))))))
@@ -73,6 +87,36 @@
(test-assert "elpa->guix-package test 1"
(eval-test-with-elpa "auctex"))
+(test-equal "package-latest-release"
+ (list '("https://elpa.gnu.org/packages/taxy-magit-section-0.12.2.tar")
+ '("https://elpa.gnu.org/packages/taxy-magit-section-0.12.2.tar.sig")
+ (list (upstream-input
+ (name "magit-section")
+ (downstream-name "emacs-magit-section")
+ (type 'propagated)
+ (min-version "3.2.1")
+ (max-version min-version))
+ (upstream-input
+ (name "taxy")
+ (downstream-name "emacs-taxy")
+ (type 'propagated)
+ (min-version "0.10")
+ (max-version #f))))
+ (with-http-server `((200 ,(object->string elpa-mock-archive)))
+ (parameterize ((current-http-proxy (%local-url)))
+ (define source
+ (package-latest-release
+ (dummy-package "emacs-taxy-magit-section"
+ (version "0.0.0")
+ (source (dummy-origin
+ (method url-fetch)
+ (uri "https://elpa.gnu.org/xyz"))))
+ (list %elpa-updater)))
+
+ (list (upstream-source-urls source)
+ (upstream-source-signature-urls source)
+ (upstream-source-inputs source)))))
+
(test-equal "guix-package->elpa-name: without 'upstream-name' property"
"auctex"
(guix-package->elpa-name (dummy-package "emacs-auctex")))
diff --git a/tests/gem.scm b/tests/gem.scm
index 6aa0d279dc..7e2436e3fb 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
+;;; Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,6 +23,9 @@
(define-module (test-gem)
#:use-module (guix import gem)
+ #:use-module (guix upstream)
+ #:use-module ((guix download) #:select (url-fetch))
+ #:use-module ((guix build-system ruby) #:select (rubygems-uri))
#:use-module (guix base32)
#:use-module (gcrypt hash)
#:use-module (guix tests)
@@ -101,21 +105,21 @@
(string-length test-foo-json)))
(_ (error "Unexpected URL: " url)))))
(match (gem->guix-package "foo")
- (('package
- ('name "ruby-foo")
- ('version "1.0.0")
- ('source ('origin
- ('method 'url-fetch)
- ('uri ('rubygems-uri "foo" 'version))
- ('sha256
- ('base32
+ (`(package
+ (name "ruby-foo")
+ (version "1.0.0")
+ (source (origin
+ (method url-fetch)
+ (uri (rubygems-uri "foo" version))
+ (sha256
+ (base32
"1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
- ('build-system 'ruby-build-system)
- ('propagated-inputs ('list 'bundler 'ruby-bar))
- ('synopsis "A cool gem")
- ('description "This package provides a cool gem")
- ('home-page "https://example.com")
- ('license ('list 'license:expat 'license:asl2.0)))
+ (build-system ruby-build-system)
+ (propagated-inputs (list bundler ruby-bar))
+ (synopsis "A cool gem")
+ (description "This package provides a cool gem")
+ (home-page "https://example.com")
+ (license (list license:expat license:asl2.0)))
#t)
(x
(pk 'fail x #f)))))
@@ -130,21 +134,21 @@
(string-length test-foo-v2-json)))
(_ (error "Unexpected URL: " url)))))
(match (gem->guix-package "foo" #:version "2.0.0")
- (('package
- ('name "ruby-foo")
- ('version "2.0.0")
- ('source ('origin
- ('method 'url-fetch)
- ('uri ('rubygems-uri "foo" 'version))
- ('sha256
- ('base32
+ (`(package
+ (name "ruby-foo")
+ (version "2.0.0")
+ (source (origin
+ (method url-fetch)
+ (uri (rubygems-uri "foo" version))
+ (sha256
+ (base32
"1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
- ('build-system 'ruby-build-system)
- ('propagated-inputs ('list 'bundler 'ruby-bar))
- ('synopsis "A cool gem")
- ('description "This package provides a cool gem")
- ('home-page "https://example.com")
- ('license ('list 'license:expat 'license:asl2.0)))
+ (build-system ruby-build-system)
+ (propagated-inputs (list bundler ruby-bar))
+ (synopsis "A cool gem")
+ (description "This package provides a cool gem")
+ (home-page "https://example.com")
+ (license (list license:expat license:asl2.0)))
#t)
(x
(pk 'fail x #f)))))
@@ -165,53 +169,38 @@
(string-length test-bundler-json)))
(_ (error "Unexpected URL: " url)))))
(match (gem-recursive-import "foo")
- ((('package
- ('name "ruby-bar")
- ('version "1.0.0")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('rubygems-uri "bar" 'version))
- ('sha256
- ('base32
- "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
- ('build-system 'ruby-build-system)
- ('propagated-inputs ('list 'bundler))
- ('synopsis "Another cool gem")
- ('description "Another cool gem")
- ('home-page "https://example.com")
- ('license #f)) ;no licensing info
- ('package
- ('name "ruby-bundler")
- ('version "1.14.2")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('rubygems-uri "bundler" 'version))
- ('sha256
- ('base32
- "1446xiz7zg0bz7kgx9jv84y0s4hpsg61dj5l3qb0i00avc1kxd9v"))))
- ('build-system 'ruby-build-system)
- ('synopsis "Ruby gem bundler")
- ('description "Ruby gem bundler")
- ('home-page "https://bundler.io/")
- ('license 'license:expat))
- ('package
- ('name "ruby-foo")
- ('version "1.0.0")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('rubygems-uri "foo" 'version))
- ('sha256
- ('base32
- "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
- ('build-system 'ruby-build-system)
- ('propagated-inputs ('list 'bundler 'ruby-bar))
- ('synopsis "A cool gem")
- ('description "This package provides a cool gem")
- ('home-page "https://example.com")
- ('license ('list 'license:expat 'license:asl2.0))))
+ (`((package
+ (name "ruby-bar")
+ (version "1.0.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (rubygems-uri "bar" version))
+ (sha256
+ (base32
+ "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
+ (build-system ruby-build-system)
+ (propagated-inputs (list bundler))
+ (synopsis "Another cool gem")
+ (description "Another cool gem")
+ (home-page "https://example.com")
+ (license #f)) ;no licensing info
+ (package
+ (name "ruby-foo")
+ (version "1.0.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (rubygems-uri "foo" version))
+ (sha256
+ (base32
+ "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
+ (build-system ruby-build-system)
+ (propagated-inputs (list bundler ruby-bar))
+ (synopsis "A cool gem")
+ (description "This package provides a cool gem")
+ (home-page "https://example.com")
+ (license (list license:expat license:asl2.0))))
#t)
(x
(pk 'fail x #f)))))
@@ -232,55 +221,67 @@
(string-length test-bundler-json)))
(_ (error "Unexpected URL: " url)))))
(match (gem-recursive-import "foo" "2.0.0")
- ((('package
- ('name "ruby-bar")
- ('version "1.0.0")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('rubygems-uri "bar" 'version))
- ('sha256
- ('base32
- "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
- ('build-system 'ruby-build-system)
- ('propagated-inputs ('list 'bundler))
- ('synopsis "Another cool gem")
- ('description "Another cool gem")
- ('home-page "https://example.com")
- ('license #f)) ;no licensing info
- ('package
- ('name "ruby-bundler")
- ('version "1.14.2")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('rubygems-uri "bundler" 'version))
- ('sha256
- ('base32
- "1446xiz7zg0bz7kgx9jv84y0s4hpsg61dj5l3qb0i00avc1kxd9v"))))
- ('build-system 'ruby-build-system)
- ('synopsis "Ruby gem bundler")
- ('description "Ruby gem bundler")
- ('home-page "https://bundler.io/")
- ('license 'license:expat))
- ('package
- ('name "ruby-foo")
- ('version "2.0.0")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('rubygems-uri "foo" 'version))
- ('sha256
- ('base32
- "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
- ('build-system 'ruby-build-system)
- ('propagated-inputs ('list 'bundler 'ruby-bar))
- ('synopsis "A cool gem")
- ('description "This package provides a cool gem")
- ('home-page "https://example.com")
- ('license ('list 'license:expat 'license:asl2.0))))
+ (`((package
+ (name "ruby-bar")
+ (version "1.0.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (rubygems-uri "bar" version))
+ (sha256
+ (base32
+ "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
+ (build-system ruby-build-system)
+ (propagated-inputs (list bundler))
+ (synopsis "Another cool gem")
+ (description "Another cool gem")
+ (home-page "https://example.com")
+ (license #f)) ;no licensing info
+ (package
+ (name "ruby-foo")
+ (version "2.0.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (rubygems-uri "foo" version))
+ (sha256
+ (base32
+ "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
+ (build-system ruby-build-system)
+ (propagated-inputs (list bundler ruby-bar))
+ (synopsis "A cool gem")
+ (description "This package provides a cool gem")
+ (home-page "https://example.com")
+ (license (list license:expat license:asl2.0))))
#t)
(x
(pk 'fail x #f)))))
+(test-equal "package-latest-release"
+ (list '("https://rubygems.org/downloads/foo-1.0.0.gem")
+ (list (upstream-input
+ (name "bundler")
+ (downstream-name name)
+ (type 'propagated))
+ (upstream-input
+ (name "bar")
+ (downstream-name "ruby-bar")
+ (type 'propagated))))
+ (mock ((guix http-client) http-fetch
+ (lambda (url . rest)
+ (match url
+ ("https://rubygems.org/api/v1/gems/foo.json"
+ (values (open-input-string test-foo-json)
+ (string-length test-foo-json)))
+ (_ (error "Unexpected URL: " url)))))
+ (let ((source (package-latest-release
+ (dummy-package "ruby-foo"
+ (version "0.1.2")
+ (source (dummy-origin
+ (method url-fetch)
+ (uri (rubygems-uri "foo"
+ version))))))))
+ (list (upstream-source-urls source)
+ (upstream-source-inputs source)))))
+
(test-end "gem")
diff --git a/tests/guix-refresh.sh b/tests/guix-refresh.sh
index 691020b031..51d34c4b51 100644
--- a/tests/guix-refresh.sh
+++ b/tests/guix-refresh.sh
@@ -34,7 +34,8 @@ GUIX_TEST_UPDATER_TARGETS='
("1.6.4" "file:///dev/null")))
("libreoffice" "" (("1.0" "file:///dev/null")))
("idutils" "" (("'$idutils_version'" "file:///dev/null")))
- ("the-test-package" "" (("5.5" "file://'$PWD/$module_dir'/source"))))'
+ ("the-test-package" "" (("5.5" "file://'$PWD/$module_dir'/source"
+ ("grep" "sed" "libreoffice")))))'
# No newer version available.
guix refresh -t test idutils # XXX: should return non-zero?
@@ -91,13 +92,16 @@ cat > "$module_dir/sample.scm"<<EOF
".tar.gz"))
(sha256
(base32
- "086vqwk2wl8zfs47sq2xpjc9k066ilmb8z6dn0q6ymwjzlm196cd"))))))
+ "086vqwk2wl8zfs47sq2xpjc9k066ilmb8z6dn0q6ymwjzlm196cd"))))
+ (inputs (list coreutils tar))
+ (properties '((updater-ignored-inputs . ("libreoffice"))))))
EOF
guix refresh -t test -L "$module_dir" the-test-package
guix refresh -t test -L "$module_dir" the-test-package -u \
--keyring="$module_dir/keyring.kbx" # so we don't create $HOME/.config
grep 'version "5.5"' "$module_dir/sample.scm"
grep "$(guix hash -H sha256 -f nix-base32 "$module_dir/source")" "$module_dir/sample.scm"
+grep '(inputs (list grep sed))' "$module_dir/sample.scm"
# Specifying a target version.
guix refresh -t test guile=2.0.0 # XXX: should return non-zero?
diff --git a/tests/hexpm.scm b/tests/hexpm.scm
index e9f899f166..5df9af0ca6 100644
--- a/tests/hexpm.scm
+++ b/tests/hexpm.scm
@@ -139,22 +139,22 @@
"source")
(_ (error "url-fetch got unexpected URL: " url))))))))
(match (hexpm->guix-package "bla")
- (('package
- ('name "erlang-bla")
- ('version "1.5.0")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('hexpm-uri "bla" 'version))
- ('sha256
- ('base32
- "0zcl4dgcmqwl1g5xb901pd6dz61r1xgmac9mqlwvh022paa6gks1"))))
- ('build-system 'rebar-build-system)
- ('inputs ('list 'erlang-blubb 'erlang-fasel))
- ('synopsis "A cool package")
- ('description "This package provides a cool package")
- ('home-page "https://hex.pm/packages/bla")
- ('license ('list 'license:expat 'license:asl2.0)))
+ (`(package
+ (name "erlang-bla")
+ (version "1.5.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (hexpm-uri "bla" version))
+ (sha256
+ (base32
+ "0zcl4dgcmqwl1g5xb901pd6dz61r1xgmac9mqlwvh022paa6gks1"))))
+ (build-system rebar-build-system)
+ (inputs (list erlang-blubb erlang-fasel))
+ (synopsis "A cool package")
+ (description "This package provides a cool package")
+ (home-page "https://hex.pm/packages/bla")
+ (license (list license:expat license:asl2.0)))
#t)
(x
(pk 'fail x #f))))))
@@ -199,53 +199,53 @@
"fasel-source")
(_ (error "url-fetch got unexpected URL: " url))))))))
(match (hexpm-recursive-import "bla")
- ((('package
- ('name "erlang-blubb")
- ('version "0.3.1")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('hexpm-uri "blubb" 'version))
- ('sha256
- ('base32
- "17y88b5y8ld7s1c2bcwwwa04pf1cl4402i9zk3inna221ps3ppj2"))))
- ('build-system 'mix-build-system)
- ('inputs ('list 'erlang-fasel))
- ('synopsis "Another cool package")
- ('description "Another cool package")
- ('home-page "https://hex.pm/packages/blubb")
- ('license 'license:expat))
- ('package
- ('name "erlang-fasel")
- ('version "1.2.1")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('hexpm-uri "fasel" 'version))
- ('sha256
- ('base32
- "1k6d70mxwqgq78jrbr7yqnw187yki74jnagybi7nacrj4a67qjha"))))
- ('build-system 'gnu-build-system)
- ('synopsis "Yet another cool package")
- ('description "Yet another cool package")
- ('home-page "https://hex.pm/packages/fasel")
- ('license "GPL"))
- ('package
- ('name "erlang-bla")
- ('version "1.5.0")
- ('source
- ('origin
- ('method 'url-fetch)
- ('uri ('hexpm-uri "bla" 'version))
- ('sha256
- ('base32
- "0d3gj746c4swbb1m6ycylxb239jsavvdcizag6bfbg2aqccxwij8"))))
- ('build-system 'rebar-build-system)
- ('inputs ('list 'erlang-blubb 'erlang-fasel))
- ('synopsis "A cool package")
- ('description "This package provides a cool package")
- ('home-page "https://hex.pm/packages/bla")
- ('license ('list 'license:expat 'license:asl2.0))))
+ (`((package
+ (name "erlang-blubb")
+ (version "0.3.1")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (hexpm-uri "blubb" version))
+ (sha256
+ (base32
+ "17y88b5y8ld7s1c2bcwwwa04pf1cl4402i9zk3inna221ps3ppj2"))))
+ (build-system mix-build-system)
+ (inputs (list erlang-fasel))
+ (synopsis "Another cool package")
+ (description "Another cool package")
+ (home-page "https://hex.pm/packages/blubb")
+ (license license:expat))
+ (package
+ (name "erlang-fasel")
+ (version "1.2.1")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (hexpm-uri "fasel" version))
+ (sha256
+ (base32
+ "1k6d70mxwqgq78jrbr7yqnw187yki74jnagybi7nacrj4a67qjha"))))
+ (build-system gnu-build-system)
+ (synopsis "Yet another cool package")
+ (description "Yet another cool package")
+ (home-page "https://hex.pm/packages/fasel")
+ (license "GPL"))
+ (package
+ (name "erlang-bla")
+ (version "1.5.0")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (hexpm-uri "bla" version))
+ (sha256
+ (base32
+ "0d3gj746c4swbb1m6ycylxb239jsavvdcizag6bfbg2aqccxwij8"))))
+ (build-system rebar-build-system)
+ (inputs (list erlang-blubb erlang-fasel))
+ (synopsis "A cool package")
+ (description "This package provides a cool package")
+ (home-page "https://hex.pm/packages/bla")
+ (license (list license:expat license:asl2.0))))
#t)
(x
(pk 'fail x #f))))))
diff --git a/tests/opam.scm b/tests/opam.scm
index b5f02f809b..832fea1d9b 100644
--- a/tests/opam.scm
+++ b/tests/opam.scm
@@ -92,23 +92,22 @@ url {
(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))
+ (`(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))
diff --git a/tests/pypi.scm b/tests/pypi.scm
index 1ddcc542ff..42b39cde73 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -25,11 +25,19 @@
#:use-module (guix base32)
#:use-module (guix memoization)
#:use-module (guix utils)
+ #:use-module ((guix base16) #:select (base16-string->bytevector))
+ #:use-module (guix upstream)
#:use-module (gcrypt hash)
#:use-module (guix tests)
+ #:use-module (guix tests http)
+ #:use-module ((guix download) #:select (url-fetch))
#:use-module (guix build-system python)
- #:use-module ((guix build utils) #:select (delete-file-recursively which mkdir-p))
+ #:use-module ((guix build utils)
+ #:select (delete-file-recursively
+ which mkdir-p dump-port
+ with-directory-excursion))
#:use-module ((guix diagnostics) #:select (guix-warning-port))
+ #:use-module ((guix build syscalls) #:select (mkdtemp!))
#:use-module (json)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
@@ -38,6 +46,12 @@
#:use-module (ice-9 match)
#:use-module (ice-9 optargs))
+(define default-sha256
+ "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")
+(define default-sha256/base32
+ (bytevector->nix-base32-string
+ (base16-string->bytevector default-sha256)))
+
(define* (foo-json #:key (name "foo") (name-in-url #f))
"Create a JSON description of an example pypi package, named @var{name},
optionally using a different @var{name in its URL}."
@@ -53,25 +67,20 @@ optionally using a different @var{name in its URL}."
(urls . #())
(releases
. ((1.0.0
- . #(((url . ,(format #f "https://example.com/~a-1.0.0.egg"
+ . #(((url . ,(format #f "~a/~a-1.0.0.egg"
+ (%local-url #:path "")
(or name-in-url name)))
(packagetype . "bdist_egg"))
- ((url . ,(format #f "https://example.com/~a-1.0.0.tar.gz"
+ ((url . ,(format #f "~a/~a-1.0.0.tar.gz"
+ (%local-url #:path "")
(or name-in-url name)))
- (packagetype . "sdist"))
- ((url . ,(format #f "https://example.com/~a-1.0.0-py2.py3-none-any.whl"
+ (packagetype . "sdist")
+ (digests . (("sha256" . ,default-sha256))))
+ ((url . ,(format #f "~a/~a-1.0.0-py2.py3-none-any.whl"
+ (%local-url #:path "")
(or name-in-url name)))
(packagetype . "bdist_wheel")))))))))
-(define test-json-1
- (foo-json))
-
-(define test-json-2
- (foo-json #:name "foo-99"))
-
-(define test-source-hash
- "")
-
(define test-specifications
'("Fizzy [foo, bar]"
"PickyThing<1.6,>1.9,!=1.9.6,<2.0a0,==2.4c1"
@@ -131,6 +140,70 @@ Provides-Extra: testing
Requires-Dist: pytest (>=3.1.0); extra == 'testing'
")
+(define sample-directory
+ ;; Directory containing tarballs and .whl files for this test.
+ (let ((template (string-append (or (getenv "TMPDIR") "/tmp")
+ "/guix-pypi-test-XXXXXX")))
+ (mkdtemp! template)))
+
+(define (pypi-tarball name specs)
+ "Return a PyPI tarball called NAME suffixed with '.tar.gz' and containing
+the files specified in SPECS. Return its file name."
+ (let ((directory (in-vicinity sample-directory name))
+ (tarball (in-vicinity sample-directory (string-append name ".tar.gz"))))
+ (false-if-exception (delete-file tarball))
+ (mkdir-p directory)
+ (for-each (match-lambda
+ ((file content)
+ (mkdir-p (in-vicinity directory (dirname file)))
+ (call-with-output-file (in-vicinity directory file)
+ (lambda (port)
+ (display content port)))))
+ specs)
+ (parameterize ((current-output-port (%make-void-port "w0")))
+ (system* "tar" "-C" sample-directory "-czvf" tarball
+ (basename directory)))
+ (delete-file-recursively directory)
+ tarball))
+
+(define (wheel-file name specs)
+ "Return a Wheel file called NAME suffixed with '.whl' and containing the
+files specified by SPECS. Return its file name."
+ (let* ((directory (in-vicinity sample-directory
+ (string-append name ".dist-info")))
+ (zip-file (in-vicinity sample-directory
+ (string-append name ".zip")))
+ (whl-file (in-vicinity sample-directory
+ (string-append name ".whl"))))
+ (false-if-exception (delete-file whl-file))
+ (mkdir-p directory)
+ (for-each (match-lambda
+ ((file content)
+ (mkdir-p (in-vicinity directory (dirname file)))
+ (call-with-output-file (in-vicinity directory file)
+ (lambda (port)
+ (display content port)))))
+ specs)
+ ;; zip always adds a "zip" extension to the file it creates,
+ ;; so we need to rename it.
+ (with-directory-excursion (dirname directory)
+ (system* "zip" "-qr" zip-file (basename directory)))
+ (rename-file zip-file whl-file)
+ (delete-file-recursively directory)
+ whl-file))
+
+(define (file-dump file)
+ "Return a procedure that dumps FILE to the given port."
+ (lambda (output)
+ (call-with-input-file file
+ (lambda (input)
+ (dump-port input output)))))
+
+(define-syntax-rule (with-pypi responses body ...)
+ (with-http-server responses
+ (parameterize ((%pypi-base-url (%local-url #:path "/")))
+ body ...)))
+
(test-begin "pypi")
@@ -219,218 +292,174 @@ Requires-Dist: pytest (>=3.1.0); extra == 'testing'
"https://files.pythonhosted.org/packages/f0/f00/goo-0.0.0.tar.gz"))
(test-assert "pypi->guix-package, no wheel"
- ;; Replace network resources with sample data.
- (mock ((guix import utils) url-fetch
- (lambda (url file-name)
- (match url
- ("https://example.com/foo-1.0.0.tar.gz"
- (begin
- ;; Unusual requires.txt location should still be found.
- (mkdir-p "foo-1.0.0/src/bizarre.egg-info")
- (with-output-to-file "foo-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-1.0.0/"))
- (delete-file-recursively "foo-1.0.0")
- (set! test-source-hash
- (call-with-input-file file-name port-sha256))))
- ("https://example.com/foo-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/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")
- (('package
- ('name "python-foo")
- ('version "1.0.0")
- ('source ('origin
- ('method 'url-fetch)
- ('uri ('pypi-uri "foo" 'version))
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'pyproject-build-system)
- ('propagated-inputs ('list 'python-bar 'python-foo))
- ('native-inputs ('list 'python-pytest))
- ('home-page "http://example.com")
- ('synopsis "summary")
- ('description "summary")
- ('license 'license:lgpl2.0))
- (and (string=? (bytevector->nix-base32-string
- test-source-hash)
- hash)
- (equal? (pypi->guix-package "foo" #:version "1.0.0")
- (pypi->guix-package "foo"))
- (guard (c ((error? c) #t))
- (pypi->guix-package "foo" #:version "42"))))
- (x
- (pk 'fail x #f))))))
+ (let ((tarball (pypi-tarball
+ "foo-1.0.0"
+ `(("src/bizarre.egg-info/requires.txt"
+ ,test-requires.txt))))
+ (twice (lambda (lst) (append lst lst))))
+ (with-pypi (twice `(("/foo-1.0.0.tar.gz" 200 ,(file-dump tarball))
+ ("/foo-1.0.0-py2.py3-none-any.whl" 404 "")
+ ("/foo/json" 200 ,(lambda (port)
+ (display (foo-json) port)))))
+ (match (pypi->guix-package "foo")
+ (`(package
+ (name "python-foo")
+ (version "1.0.0")
+ (source (origin
+ (method url-fetch)
+ (uri (pypi-uri "foo" version))
+ (sha256
+ (base32 ,(? string? hash)))))
+ (build-system pyproject-build-system)
+ (propagated-inputs (list python-bar python-foo))
+ (native-inputs (list python-pytest))
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license license:lgpl2.0))
+ (and (string=? default-sha256/base32 hash)
+ (equal? (pypi->guix-package "foo" #:version "1.0.0")
+ (pypi->guix-package "foo"))
+ (guard (c ((error? c) #t))
+ (pypi->guix-package "foo" #:version "42"))))
+ (x
+ (pk 'fail x #f))))))
(test-skip (if (which "zip") 0 1))
(test-assert "pypi->guix-package, wheels"
- ;; Replace network resources with sample data.
- (mock ((guix import utils) url-fetch
- (lambda (url file-name)
- (match url
- ("https://example.com/foo-1.0.0.tar.gz"
- (begin
- (mkdir-p "foo-1.0.0/foo.egg-info/")
- (with-output-to-file "foo-1.0.0/foo.egg-info/requires.txt"
- (lambda ()
- (display "wrong data to make sure we're testing wheels ")))
- (parameterize ((current-output-port (%make-void-port "rw+")))
- (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))))
- ("https://example.com/foo-1.0.0-py2.py3-none-any.whl"
- (begin
- (mkdir "foo-1.0.0.dist-info")
- (with-output-to-file "foo-1.0.0.dist-info/METADATA"
- (lambda ()
- (display test-metadata)))
- (let ((zip-file (string-append file-name ".zip")))
- ;; zip always adds a "zip" extension to the file it creates,
- ;; so we need to rename it.
- (system* "zip" "-q" zip-file "foo-1.0.0.dist-info/METADATA")
- (rename-file zip-file file-name))
- (delete-file-recursively "foo-1.0.0.dist-info")))
- (_ (error "Unexpected URL: " url)))))
- (mock ((guix http-client) http-fetch
- (lambda (url . rest)
- (match url
- ("https://pypi.org/pypi/foo/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
- ;; computed in the previous test.
- (invalidate-memoization! pypi->guix-package)
- (match (pypi->guix-package "foo")
- (('package
- ('name "python-foo")
- ('version "1.0.0")
- ('source ('origin
- ('method 'url-fetch)
- ('uri ('pypi-uri "foo" 'version))
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'pyproject-build-system)
- ('propagated-inputs ('list 'python-bar 'python-baz))
- ('native-inputs ('list '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))))))
+ (let ((tarball (pypi-tarball
+ "foo-1.0.0"
+ '(("foo-1.0.0/foo.egg-info/requires.txt"
+ "wrong data \
+to make sure we're testing wheels"))))
+ (wheel (wheel-file "foo-1.0.0"
+ `(("METADATA" ,test-metadata)))))
+ (with-pypi `(("/foo-1.0.0.tar.gz" 200 ,(file-dump tarball))
+ ("/foo-1.0.0-py2.py3-none-any.whl"
+ 200 ,(file-dump wheel))
+ ("/foo/json" 200 ,(lambda (port)
+ (display (foo-json) port))))
+ ;; Not clearing the memoization cache here would mean returning the value
+ ;; computed in the previous test.
+ (invalidate-memoization! pypi->guix-package)
+ (match (pypi->guix-package "foo")
+ (`(package
+ (name "python-foo")
+ (version "1.0.0")
+ (source (origin
+ (method url-fetch)
+ (uri (pypi-uri "foo" version))
+ (sha256
+ (base32 ,(? string? hash)))))
+ (build-system pyproject-build-system)
+ (propagated-inputs (list python-bar python-baz))
+ (native-inputs (list python-pytest))
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license license:lgpl2.0))
+ (string=? default-sha256/base32 hash))
+ (x
+ (pk 'fail x #f))))))
(test-assert "pypi->guix-package, no usable requirement file."
- ;; Replace network resources with sample data.
- (mock ((guix import utils) url-fetch
- (lambda (url file-name)
- (match url
- ("https://example.com/foo-1.0.0.tar.gz"
- (mkdir-p "foo-1.0.0/foo.egg-info/")
- (parameterize ((current-output-port (%make-void-port "rw+")))
- (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)))
- ("https://example.com/foo-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/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
- ;; computed in the previous test.
- (invalidate-memoization! pypi->guix-package)
- (match (pypi->guix-package "foo")
- (('package
- ('name "python-foo")
- ('version "1.0.0")
- ('source ('origin
- ('method 'url-fetch)
- ('uri ('pypi-uri "foo" 'version))
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'pyproject-build-system)
- ('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))))))
+ (let ((tarball (pypi-tarball "foo-1.0.0"
+ '(("foo.egg-info/.empty" "")))))
+ (with-pypi `(("/foo-1.0.0.tar.gz" 200 ,(file-dump tarball))
+ ("/foo-1.0.0-py2.py3-none-any.whl" 404 "")
+ ("/foo/json" 200 ,(lambda (port)
+ (display (foo-json) port))))
+ ;; Not clearing the memoization cache here would mean returning the
+ ;; value computed in the previous test.
+ (invalidate-memoization! pypi->guix-package)
+ (match (pypi->guix-package "foo")
+ (`(package
+ (name "python-foo")
+ (version "1.0.0")
+ (source (origin
+ (method url-fetch)
+ (uri (pypi-uri "foo" version))
+ (sha256
+ (base32 ,(? string? hash)))))
+ (build-system pyproject-build-system)
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license license:lgpl2.0))
+ (string=? default-sha256/base32 hash))
+ (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 'pyproject-build-system)
- ('propagated-inputs ('list 'python-bar 'python-foo))
- ('native-inputs ('list '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))))))
+ (let ((tarball (pypi-tarball "foo-99-1.0.0"
+ `(("src/bizarre.egg-info/requires.txt"
+ ,test-requires.txt)))))
+ (with-pypi `(("/foo-99-1.0.0.tar.gz" 200 ,(file-dump tarball))
+ ("/foo-99-1.0.0-py2.py3-none-any.whl" 404 "")
+ ("/foo-99/json" 200 ,(lambda (port)
+ (display (foo-json #:name "foo-99")
+ port))))
+ (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 pyproject-build-system)
+ (propagated-inputs (list python-bar python-foo))
+ (native-inputs (list python-pytest))
+ (home-page "http://example.com")
+ (synopsis "summary")
+ (description "summary")
+ (license license:lgpl2.0))
+ (string=? default-sha256/base32 hash))
+ (x
+ (pk 'fail x #f))))))
+
+(test-equal "package-latest-release"
+ (list '("foo-1.0.0.tar.gz")
+ '("foo-1.0.0.tar.gz.asc")
+ (list (upstream-input
+ (name "bar")
+ (downstream-name "python-bar")
+ (type 'propagated))
+ (upstream-input
+ (name "foo")
+ (downstream-name "python-foo")
+ (type 'propagated))
+ (upstream-input
+ (name "pytest")
+ (downstream-name "python-pytest")
+ (type 'native))))
+ (let ((tarball (pypi-tarball
+ "foo-1.0.0"
+ `(("src/bizarre.egg-info/requires.txt"
+ ,test-requires.txt)))))
+ (with-pypi `(("/foo-1.0.0.tar.gz" 200 ,(file-dump tarball))
+ ("/foo-1.0.0-py2.py3-none-any.whl" 404 "")
+ ("/foo/json" 200 ,(lambda (port)
+ (display (foo-json) port))))
+ (define source
+ (package-latest-release
+ (dummy-package "python-foo"
+ (version "0.1.2")
+ (source (dummy-origin
+ (method url-fetch)
+ (uri (pypi-uri "foo" version))))
+ (build-system python-build-system))
+ (list %pypi-updater)))
+
+ (list (map basename (upstream-source-urls source))
+ (map basename (upstream-source-signature-urls source))
+ (upstream-source-inputs source)))))
(test-end "pypi")
+(delete-file-recursively sample-directory)
+
+;; Local Variables:
+;; eval: (put 'with-pypi 'scheme-indent-function 1)
+;; End:
diff --git a/tests/services.scm b/tests/services.scm
index 8e35758209..8cdb1b2a31 100644
--- a/tests/services.scm
+++ b/tests/services.scm
@@ -286,4 +286,87 @@
((one) one)
(x x))))
+(test-equal "modify-services: do nothing"
+ '(1 2 3)
+ (let* ((t1 (service-type (name 't1)
+ (extensions '())
+ (description "")))
+ (t2 (service-type (name 't2)
+ (extensions '())
+ (description "")))
+ (t3 (service-type (name 't3)
+ (extensions '())
+ (description "")))
+ (services (list (service t1 1) (service t2 2) (service t3 3))))
+ (sort (map service-value
+ (modify-services services))
+ <)))
+
+(test-equal "modify-services: delete service"
+ '(1)
+ (let* ((t1 (service-type (name 't1)
+ (extensions '())
+ (description "")))
+ (t2 (service-type (name 't2)
+ (extensions '())
+ (description "")))
+ (t3 (service-type (name 't3)
+ (extensions '())
+ (description "")))
+ (services (list (service t1 1) (service t2 2) (service t3 3))))
+ (sort (map service-value
+ (modify-services services
+ (delete t3)
+ (delete t2)))
+ <)))
+
+(test-error "modify-services: delete non-existing service"
+ #t
+ (let* ((t1 (service-type (name 't1)
+ (extensions '())
+ (description "")))
+ (t2 (service-type (name 't2)
+ (extensions '())
+ (description "")))
+ (t3 (service-type (name 't2)
+ (extensions '())
+ (description "")))
+ (services (list (service t1 1) (service t2 2))))
+ (modify-services services
+ (delete t3))))
+
+(test-equal "modify-services: change value"
+ '(2 11 33)
+ (let* ((t1 (service-type (name 't1)
+ (extensions '())
+ (description "")))
+ (t2 (service-type (name 't2)
+ (extensions '())
+ (description "")))
+ (t3 (service-type (name 't3)
+ (extensions '())
+ (description "")))
+ (services (list (service t1 1) (service t2 2) (service t3 3))))
+ (sort (map service-value
+ (modify-services services
+ (t1 value => 11)
+ (t3 value => 33)))
+ <)))
+
+(test-error "modify-services: change value for non-existing service"
+ #t
+ (let* ((t1 (service-type (name 't1)
+ (extensions '())
+ (description "")))
+ (t2 (service-type (name 't2)
+ (extensions '())
+ (description "")))
+ (t3 (service-type (name 't3)
+ (extensions '())
+ (description "")))
+ (services (list (service t1 1) (service t3 3))))
+ (map service-value
+ (modify-services services
+ (t2 value => 22)))))
+
(test-end)
diff --git a/tests/substitute.scm b/tests/substitute.scm
index 9032a50268..8df3938b59 100644
--- a/tests/substitute.scm
+++ b/tests/substitute.scm
@@ -64,11 +64,11 @@ it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX."
(define (request-substitution item destination)
"Run 'guix substitute --substitute' to fetch ITEM to DESTINATION."
- (parameterize ((guix-warning-port (current-error-port)))
- (with-input-from-string (string-append "substitute " item " "
- destination "\n")
- (lambda ()
- (guix-substitute "--substitute")))))
+ (false-if-exception (delete-file destination))
+ (with-input-from-string (string-append "substitute " item " "
+ destination "\n")
+ (lambda ()
+ (guix-substitute "--substitute"))))
(define %public-key
;; This key is known to be in the ACL by default.
@@ -613,6 +613,32 @@ System: mips64el-linux\n")))
(lambda ()
(false-if-exception (delete-file "substitute-retrieved")))))))))))
+(test-equal "substitute, preferred nar URL is 404, other is 200"
+ "Substitutable data."
+ (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo))
+ %main-substitute-directory
+
+ (with-http-server `((200 ,(string-append %narinfo "Signature: "
+ (signature-field %narinfo)
+ "\n"
+ "URL: example.nar.lz\n"
+ "Compression: lzip\n"))
+ (404 "Sorry, nar.lz is missing!")
+ (200 ,(call-with-input-file
+ (string-append %main-substitute-directory
+ "/example.nar")
+ get-bytevector-all)))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (parameterize ((substitute-urls (list (%local-url))))
+ (request-substitution (string-append (%store-prefix)
+ "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
+ "substitute-retrieved"))
+ (call-with-input-file "substitute-retrieved" get-string-all))
+ (lambda ()
+ (false-if-exception (delete-file "substitute-retrieved")))))))
+
(test-quit "substitute, narinfo is available but nar is missing"
"failed to find alternative substitute"
(with-narinfo*
diff --git a/tests/texlive.scm b/tests/texlive.scm
index c3631861ce..7d7ad332b4 100644
--- a/tests/texlive.scm
+++ b/tests/texlive.scm
@@ -174,27 +174,27 @@ completely compatible with Plain TeX.")
#:package-database
(lambda _ %fake-tlpdb))))
(match result
- (('package
- ('inherit ('simple-texlive-package
+ (`(package
+ (inherit (simple-texlive-package
"texlive-texsis"
- ('list "bibtex/bst/texsis/"
- "doc/man/man1/"
- "doc/otherformats/texsis/base/"
- "tex/texsis/base/"
- "tex/texsis/config/")
- ('base32 (? string? hash))
+ (list "bibtex/bst/texsis/"
+ "doc/man/man1/"
+ "doc/otherformats/texsis/base/"
+ "tex/texsis/base/"
+ "tex/texsis/config/")
+ (base32 ,(? string? hash))
#:trivial? #t))
- ('version . any)
- ('propagated-inputs
- ('list 'texlive-cm
- 'texlive-hyphen-base
- 'texlive-knuth-lib
- 'texlive-plain
- 'texlive-tex))
- ('home-page (? string?))
- ('synopsis (? string?))
- ('description (? string?))
- ('license 'lppl))
+ (version ,_)
+ (propagated-inputs
+ (list texlive-cm
+ texlive-hyphen-base
+ texlive-knuth-lib
+ texlive-plain
+ texlive-tex))
+ (home-page ,(? string?))
+ (synopsis ,(? string?))
+ (description ,(? string?))
+ (license lppl))
#true)
(_
(begin
diff --git a/tests/upstream.scm b/tests/upstream.scm
index 9aacb77229..a94bb66068 100644
--- a/tests/upstream.scm
+++ b/tests/upstream.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
@@ -32,182 +32,27 @@
(test-begin "upstream")
-;; FIXME: Temporarily skipping this test; see <https://bugs.gnu.org/34229>.
-(test-skip 1)
-
(test-equal "coalesce-sources same version"
- (list (upstream-source
- (package "foo") (version "1")
- (urls '("ftp://example.org/foo-1.tar.xz"
- "ftp://example.org/foo-1.tar.gz"))
- (signature-urls '("ftp://example.org/foo-1.tar.xz.sig"
- "ftp://example.org/foo-1.tar.gz.sig"))))
-
- (coalesce-sources (list (upstream-source
- (package "foo") (version "1")
- (urls '("ftp://example.org/foo-1.tar.gz"))
- (signature-urls
- '("ftp://example.org/foo-1.tar.gz.sig")))
- (upstream-source
- (package "foo") (version "1")
- (urls '("ftp://example.org/foo-1.tar.xz"))
- (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)))))
+ '((source "foo" "1"
+ ("ftp://example.org/foo-1.tar.xz"
+ "ftp://example.org/foo-1.tar.gz")
+ ("ftp://example.org/foo-1.tar.xz.sig"
+ "ftp://example.org/foo-1.tar.gz.sig")))
-(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)))))
+ (map (lambda (source)
+ `(source ,(upstream-source-package source)
+ ,(upstream-source-version source)
+ ,(upstream-source-urls source)
+ ,(upstream-source-signature-urls source)))
+ (coalesce-sources (list (upstream-source
+ (package "foo") (version "1")
+ (urls '("ftp://example.org/foo-1.tar.gz"))
+ (signature-urls
+ '("ftp://example.org/foo-1.tar.gz.sig")))
+ (upstream-source
+ (package "foo") (version "1")
+ (urls '("ftp://example.org/foo-1.tar.xz"))
+ (signature-urls
+ '("ftp://example.org/foo-1.tar.xz.sig")))))))
(test-end)
generated by cgit v1.2.3 (git 2.50.1) at 2025-08-05 11:02:44 +0000