ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

tests: Use quasiquoted 'match' patterns for package sexps.

Browse source 
Turns out it's easier to read.

* tests/cpan.scm ("cpan->guix-package"): Use a quasiquoted pattern.
* tests/elpa.scm (eval-test-with-elpa): Likewise.
* tests/gem.scm ("gem->guix-package")
("gem->guix-package with a specific version")
("gem-recursive-import")
("gem-recursive-import with a specific version"): Likewise.
* tests/hexpm.scm ("hexpm-recursive-import"): Likewise.
* tests/opam.scm ("opam->guix-package"): Likewise.
* tests/pypi.scm ("pypi->guix-package, no wheel")
("pypi->guix-package, wheels")
("pypi->guix-package, no usable requirement file.")
("pypi->guix-package, package name contains \"-\" followed by digits"):
Likewise.
* tests/texlive.scm ("texlive->guix-package"): Likewise.
This commit is contained in:
Ludovic Courtès 2023-05-31 23:50:06 +02:00
parent 9f7cd1fcaf
commit 654fcf9971
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
7 changed files with 278 additions and 284 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
tests/cpan.scm
View file

@ -73,22 +73,21 @@ (define test-source
(parameterize ((%metacpan-base-url (%local-url)) (parameterize ((%metacpan-base-url (%local-url))
(current-http-proxy (%local-url))) (current-http-proxy (%local-url)))
(match (cpan->guix-package "Foo::Bar") (match (cpan->guix-package "Foo::Bar")
(('package (`(package
('name "perl-foo-bar") (name "perl-foo-bar")
('version "0.1") (version "0.1")
('source ('origin (source (origin
('method 'url-fetch) (method url-fetch)
('uri ('string-append "http://example.com/Foo-Bar-" (uri (string-append "http://example.com/Foo-Bar-"
'version ".tar.gz")) version ".tar.gz"))
('sha256 (sha256
('base32 (base32 ,(? string? hash)))))
(? string? hash))))) (build-system perl-build-system)
('build-system 'perl-build-system) (propagated-inputs (list perl-test-script))
('propagated-inputs ('list 'perl-test-script)) (home-page "https://metacpan.org/release/Foo-Bar")
('home-page "https://metacpan.org/release/Foo-Bar") (synopsis "Fizzle Fuzz")
('synopsis "Fizzle Fuzz") (description fill-in-yourself!)
('description 'fill-in-yourself!) (license perl-license))
('license 'perl-license))
(string=? (bytevector->nix-base32-string (string=? (bytevector->nix-base32-string
(call-with-input-string test-source port-sha256)) (call-with-input-string test-source port-sha256))
hash)) hash))

28
tests/elpa.scm
View file

@ -66,20 +66,20 @@ (define (eval-test-with-elpa pkg)
(200 "fake tarball contents")) (200 "fake tarball contents"))
(parameterize ((current-http-proxy (%local-url))) (parameterize ((current-http-proxy (%local-url)))
(match (elpa->guix-package pkg #:repo 'gnu/http) (match (elpa->guix-package pkg #:repo 'gnu/http)
(('package (`(package
('name "emacs-auctex") (name "emacs-auctex")
('version "11.88.6") (version "11.88.6")
('source (source
('origin (origin
('method 'url-fetch) (method url-fetch)
('uri ('string-append (uri (string-append
"http://elpa.gnu.org/packages/auctex-" 'version ".tar")) "http://elpa.gnu.org/packages/auctex-" version ".tar"))
('sha256 ('base32 (? string? hash))))) (sha256 (base32 ,(? string? hash)))))
('build-system 'emacs-build-system) (build-system emacs-build-system)
('home-page "http://www.gnu.org/software/auctex/") (home-page "http://www.gnu.org/software/auctex/")
('synopsis "Integrated environment for *TeX*") (synopsis "Integrated environment for *TeX*")
('description "This is the description.") (description "This is the description.")
('license 'license:gpl3+)) (license license:gpl3+))
#t) #t)
(x (x
(pk 'fail x #f)))))) (pk 'fail x #f))))))

184
tests/gem.scm
View file

@ -105,21 +105,21 @@ (define test-bundler-json
(string-length test-foo-json))) (string-length test-foo-json)))
(_ (error "Unexpected URL: " url))))) (_ (error "Unexpected URL: " url)))))
(match (gem->guix-package "foo") (match (gem->guix-package "foo")
(('package (`(package
('name "ruby-foo") (name "ruby-foo")
('version "1.0.0") (version "1.0.0")
('source ('origin (source (origin
('method 'url-fetch) (method url-fetch)
('uri ('rubygems-uri "foo" 'version)) (uri (rubygems-uri "foo" version))
('sha256 (sha256
('base32 (base32
"1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk")))) "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
('build-system 'ruby-build-system) (build-system ruby-build-system)
('propagated-inputs ('list 'bundler 'ruby-bar)) (propagated-inputs (list bundler ruby-bar))
('synopsis "A cool gem") (synopsis "A cool gem")
('description "This package provides a cool gem") (description "This package provides a cool gem")
('home-page "https://example.com") (home-page "https://example.com")
('license ('list 'license:expat 'license:asl2.0))) (license (list license:expat license:asl2.0)))
#t) #t)
(x (x
(pk 'fail x #f))))) (pk 'fail x #f)))))
@ -134,21 +134,21 @@ (define test-bundler-json
(string-length test-foo-v2-json))) (string-length test-foo-v2-json)))
(_ (error "Unexpected URL: " url))))) (_ (error "Unexpected URL: " url)))))
(match (gem->guix-package "foo" #:version "2.0.0") (match (gem->guix-package "foo" #:version "2.0.0")
(('package (`(package
('name "ruby-foo") (name "ruby-foo")
('version "2.0.0") (version "2.0.0")
('source ('origin (source (origin
('method 'url-fetch) (method url-fetch)
('uri ('rubygems-uri "foo" 'version)) (uri (rubygems-uri "foo" version))
('sha256 (sha256
('base32 (base32
"1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk")))) "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
('build-system 'ruby-build-system) (build-system ruby-build-system)
('propagated-inputs ('list 'bundler 'ruby-bar)) (propagated-inputs (list bundler ruby-bar))
('synopsis "A cool gem") (synopsis "A cool gem")
('description "This package provides a cool gem") (description "This package provides a cool gem")
('home-page "https://example.com") (home-page "https://example.com")
('license ('list 'license:expat 'license:asl2.0))) (license (list license:expat license:asl2.0)))
#t) #t)
(x (x
(pk 'fail x #f))))) (pk 'fail x #f)))))
@ -169,38 +169,38 @@ (define test-bundler-json
(string-length test-bundler-json))) (string-length test-bundler-json)))
(_ (error "Unexpected URL: " url))))) (_ (error "Unexpected URL: " url)))))
(match (gem-recursive-import "foo") (match (gem-recursive-import "foo")
((('package (`((package
('name "ruby-bar") (name "ruby-bar")
('version "1.0.0") (version "1.0.0")
('source (source
('origin (origin
('method 'url-fetch) (method url-fetch)
('uri ('rubygems-uri "bar" 'version)) (uri (rubygems-uri "bar" version))
('sha256 (sha256
('base32 (base32
"1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk")))) "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
('build-system 'ruby-build-system) (build-system ruby-build-system)
('propagated-inputs ('list 'bundler)) (propagated-inputs (list bundler))
('synopsis "Another cool gem") (synopsis "Another cool gem")
('description "Another cool gem") (description "Another cool gem")
('home-page "https://example.com") (home-page "https://example.com")
('license #f)) ;no licensing info (license #f)) ;no licensing info
('package (package
('name "ruby-foo") (name "ruby-foo")
('version "1.0.0") (version "1.0.0")
('source (source
('origin (origin
('method 'url-fetch) (method url-fetch)
('uri ('rubygems-uri "foo" 'version)) (uri (rubygems-uri "foo" version))
('sha256 (sha256
('base32 (base32
"1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk")))) "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
('build-system 'ruby-build-system) (build-system ruby-build-system)
('propagated-inputs ('list 'bundler 'ruby-bar)) (propagated-inputs (list bundler ruby-bar))
('synopsis "A cool gem") (synopsis "A cool gem")
('description "This package provides a cool gem") (description "This package provides a cool gem")
('home-page "https://example.com") (home-page "https://example.com")
('license ('list 'license:expat 'license:asl2.0)))) (license (list license:expat license:asl2.0))))
#t) #t)
(x (x
(pk 'fail x #f))))) (pk 'fail x #f)))))
@ -221,38 +221,38 @@ (define test-bundler-json
(string-length test-bundler-json))) (string-length test-bundler-json)))
(_ (error "Unexpected URL: " url))))) (_ (error "Unexpected URL: " url)))))
(match (gem-recursive-import "foo" "2.0.0") (match (gem-recursive-import "foo" "2.0.0")
((('package (`((package
('name "ruby-bar") (name "ruby-bar")
('version "1.0.0") (version "1.0.0")
('source (source
('origin (origin
('method 'url-fetch) (method url-fetch)
('uri ('rubygems-uri "bar" 'version)) (uri (rubygems-uri "bar" version))
('sha256 (sha256
('base32 (base32
"1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk")))) "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
('build-system 'ruby-build-system) (build-system ruby-build-system)
('propagated-inputs ('list 'bundler)) (propagated-inputs (list bundler))
('synopsis "Another cool gem") (synopsis "Another cool gem")
('description "Another cool gem") (description "Another cool gem")
('home-page "https://example.com") (home-page "https://example.com")
('license #f)) ;no licensing info (license #f)) ;no licensing info
('package (package
('name "ruby-foo") (name "ruby-foo")
('version "2.0.0") (version "2.0.0")
('source (source
('origin (origin
('method 'url-fetch) (method url-fetch)
('uri ('rubygems-uri "foo" 'version)) (uri (rubygems-uri "foo" version))
('sha256 (sha256
('base32 (base32
"1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk")))) "1a270mlajhrmpqbhxcqjqypnvgrq4pgixpv3w9gwp1wrrapnwrzk"))))
('build-system 'ruby-build-system) (build-system ruby-build-system)
('propagated-inputs ('list 'bundler 'ruby-bar)) (propagated-inputs (list bundler ruby-bar))
('synopsis "A cool gem") (synopsis "A cool gem")
('description "This package provides a cool gem") (description "This package provides a cool gem")
('home-page "https://example.com") (home-page "https://example.com")
('license ('list 'license:expat 'license:asl2.0)))) (license (list license:expat license:asl2.0))))
#t) #t)
(x (x
(pk 'fail x #f))))) (pk 'fail x #f)))))

126
tests/hexpm.scm
View file

@ -139,22 +139,22 @@ (define test-fasel-release
"source") "source")
(_ (error "url-fetch got unexpected URL: " url)))))))) (_ (error "url-fetch got unexpected URL: " url))))))))
(match (hexpm->guix-package "bla") (match (hexpm->guix-package "bla")
(('package (`(package
('name "erlang-bla") (name "erlang-bla")
('version "1.5.0") (version "1.5.0")
('source (source
('origin (origin
('method 'url-fetch) (method url-fetch)
('uri ('hexpm-uri "bla" 'version)) (uri (hexpm-uri "bla" version))
('sha256 (sha256
('base32 (base32
"0zcl4dgcmqwl1g5xb901pd6dz61r1xgmac9mqlwvh022paa6gks1")))) "0zcl4dgcmqwl1g5xb901pd6dz61r1xgmac9mqlwvh022paa6gks1"))))
('build-system 'rebar-build-system) (build-system rebar-build-system)
('inputs ('list 'erlang-blubb 'erlang-fasel)) (inputs (list erlang-blubb erlang-fasel))
('synopsis "A cool package") (synopsis "A cool package")
('description "This package provides a cool package") (description "This package provides a cool package")
('home-page "https://hex.pm/packages/bla") (home-page "https://hex.pm/packages/bla")
('license ('list 'license:expat 'license:asl2.0))) (license (list license:expat license:asl2.0)))
#t) #t)
(x (x
(pk 'fail x #f)))))) (pk 'fail x #f))))))
@ -199,53 +199,53 @@ (define test-fasel-release
"fasel-source") "fasel-source")
(_ (error "url-fetch got unexpected URL: " url)))))))) (_ (error "url-fetch got unexpected URL: " url))))))))
(match (hexpm-recursive-import "bla") (match (hexpm-recursive-import "bla")
((('package (`((package
('name "erlang-blubb") (name "erlang-blubb")
('version "0.3.1") (version "0.3.1")
('source (source
('origin (origin
('method 'url-fetch) (method url-fetch)
('uri ('hexpm-uri "blubb" 'version)) (uri (hexpm-uri "blubb" version))
('sha256 (sha256
('base32 (base32
"17y88b5y8ld7s1c2bcwwwa04pf1cl4402i9zk3inna221ps3ppj2")))) "17y88b5y8ld7s1c2bcwwwa04pf1cl4402i9zk3inna221ps3ppj2"))))
('build-system 'mix-build-system) (build-system mix-build-system)
('inputs ('list 'erlang-fasel)) (inputs (list erlang-fasel))
('synopsis "Another cool package") (synopsis "Another cool package")
('description "Another cool package") (description "Another cool package")
('home-page "https://hex.pm/packages/blubb") (home-page "https://hex.pm/packages/blubb")
('license 'license:expat)) (license license:expat))
('package (package
('name "erlang-fasel") (name "erlang-fasel")
('version "1.2.1") (version "1.2.1")
('source (source
('origin (origin
('method 'url-fetch) (method url-fetch)
('uri ('hexpm-uri "fasel" 'version)) (uri (hexpm-uri "fasel" version))
('sha256 (sha256
('base32 (base32
"1k6d70mxwqgq78jrbr7yqnw187yki74jnagybi7nacrj4a67qjha")))) "1k6d70mxwqgq78jrbr7yqnw187yki74jnagybi7nacrj4a67qjha"))))
('build-system 'gnu-build-system) (build-system gnu-build-system)
('synopsis "Yet another cool package") (synopsis "Yet another cool package")
('description "Yet another cool package") (description "Yet another cool package")
('home-page "https://hex.pm/packages/fasel") (home-page "https://hex.pm/packages/fasel")
('license "GPL")) (license "GPL"))
('package (package
('name "erlang-bla") (name "erlang-bla")
('version "1.5.0") (version "1.5.0")
('source (source
('origin (origin
('method 'url-fetch) (method url-fetch)
('uri ('hexpm-uri "bla" 'version)) (uri (hexpm-uri "bla" version))
('sha256 (sha256
('base32 (base32
"0d3gj746c4swbb1m6ycylxb239jsavvdcizag6bfbg2aqccxwij8")))) "0d3gj746c4swbb1m6ycylxb239jsavvdcizag6bfbg2aqccxwij8"))))
('build-system 'rebar-build-system) (build-system rebar-build-system)
('inputs ('list 'erlang-blubb 'erlang-fasel)) (inputs (list erlang-blubb erlang-fasel))
('synopsis "A cool package") (synopsis "A cool package")
('description "This package provides a cool package") (description "This package provides a cool package")
('home-page "https://hex.pm/packages/bla") (home-page "https://hex.pm/packages/bla")
('license ('list 'license:expat 'license:asl2.0)))) (license (list license:expat license:asl2.0))))
#t) #t)
(x (x
(pk 'fail x #f)))))) (pk 'fail x #f))))))

33
tests/opam.scm
View file

@ -92,23 +92,22 @@ (define test-repo
(lambda _ (lambda _
(format #t "~a" test-opam-file)))) (format #t "~a" test-opam-file))))
(match (opam->guix-package "foo" #:repo (list test-repo)) (match (opam->guix-package "foo" #:repo (list test-repo))
(('package (`(package
('name "ocaml-foo") (name "ocaml-foo")
('version "1.0.0") (version "1.0.0")
('source ('origin (source (origin
('method 'url-fetch) (method url-fetch)
('uri "https://example.org/foo-1.0.0.tar.gz") (uri "https://example.org/foo-1.0.0.tar.gz")
('sha256 (sha256
('base32 (base32 ,(? string? hash)))))
(? string? hash))))) (build-system ocaml-build-system)
('build-system 'ocaml-build-system) (propagated-inputs (list ocaml-zarith))
('propagated-inputs ('list 'ocaml-zarith)) (native-inputs
('native-inputs (list ocaml-alcotest ocamlbuild))
('list 'ocaml-alcotest 'ocamlbuild)) (home-page "https://example.org/")
('home-page "https://example.org/") (synopsis "Some example package")
('synopsis "Some example package") (description "This package is just an example.")
('description "This package is just an example.") (license license:bsd-3))
('license 'license:bsd-3))
(string=? (bytevector->nix-base32-string (string=? (bytevector->nix-base32-string
test-source-hash) test-source-hash)
hash)) hash))

122
tests/pypi.scm
View file

@ -302,22 +302,21 @@ (define-syntax-rule (with-pypi responses body ...)
("/foo/json" 200 ,(lambda (port) ("/foo/json" 200 ,(lambda (port)
(display (foo-json) port))))) (display (foo-json) port)))))
(match (pypi->guix-package "foo") (match (pypi->guix-package "foo")
(('package (`(package
('name "python-foo") (name "python-foo")
('version "1.0.0") (version "1.0.0")
('source ('origin (source (origin
('method 'url-fetch) (method url-fetch)
('uri ('pypi-uri "foo" 'version)) (uri (pypi-uri "foo" version))
('sha256 (sha256
('base32 (base32 ,(? string? hash)))))
(? string? hash))))) (build-system pyproject-build-system)
('build-system 'pyproject-build-system) (propagated-inputs (list python-bar python-foo))
('propagated-inputs ('list 'python-bar 'python-foo)) (native-inputs (list python-pytest))
('native-inputs ('list 'python-pytest)) (home-page "http://example.com")
('home-page "http://example.com") (synopsis "summary")
('synopsis "summary") (description "summary")
('description "summary") (license license:lgpl2.0))
('license 'license:lgpl2.0))
(and (string=? default-sha256/base32 hash) (and (string=? default-sha256/base32 hash)
(equal? (pypi->guix-package "foo" #:version "1.0.0") (equal? (pypi->guix-package "foo" #:version "1.0.0")
(pypi->guix-package "foo")) (pypi->guix-package "foo"))
@ -344,22 +343,21 @@ (define-syntax-rule (with-pypi responses body ...)
;; computed in the previous test. ;; computed in the previous test.
(invalidate-memoization! pypi->guix-package) (invalidate-memoization! pypi->guix-package)
(match (pypi->guix-package "foo") (match (pypi->guix-package "foo")
(('package (`(package
('name "python-foo") (name "python-foo")
('version "1.0.0") (version "1.0.0")
('source ('origin (source (origin
('method 'url-fetch) (method url-fetch)
('uri ('pypi-uri "foo" 'version)) (uri (pypi-uri "foo" version))
('sha256 (sha256
('base32 (base32 ,(? string? hash)))))
(? string? hash))))) (build-system pyproject-build-system)
('build-system 'pyproject-build-system) (propagated-inputs (list python-bar python-baz))
('propagated-inputs ('list 'python-bar 'python-baz)) (native-inputs (list python-pytest))
('native-inputs ('list 'python-pytest)) (home-page "http://example.com")
('home-page "http://example.com") (synopsis "summary")
('synopsis "summary") (description "summary")
('description "summary") (license license:lgpl2.0))
('license 'license:lgpl2.0))
(string=? default-sha256/base32 hash)) (string=? default-sha256/base32 hash))
(x (x
(pk 'fail x #f)))))) (pk 'fail x #f))))))
@ -375,20 +373,19 @@ (define-syntax-rule (with-pypi responses body ...)
;; value computed in the previous test. ;; value computed in the previous test.
(invalidate-memoization! pypi->guix-package) (invalidate-memoization! pypi->guix-package)
(match (pypi->guix-package "foo") (match (pypi->guix-package "foo")
(('package (`(package
('name "python-foo") (name "python-foo")
('version "1.0.0") (version "1.0.0")
('source ('origin (source (origin
('method 'url-fetch) (method url-fetch)
('uri ('pypi-uri "foo" 'version)) (uri (pypi-uri "foo" version))
('sha256 (sha256
('base32 (base32 ,(? string? hash)))))
(? string? hash))))) (build-system pyproject-build-system)
('build-system 'pyproject-build-system) (home-page "http://example.com")
('home-page "http://example.com") (synopsis "summary")
('synopsis "summary") (description "summary")
('description "summary") (license license:lgpl2.0))
('license 'license:lgpl2.0))
(string=? default-sha256/base32 hash)) (string=? default-sha256/base32 hash))
(x (x
(pk 'fail x #f)))))) (pk 'fail x #f))))))
@ -403,23 +400,22 @@ (define-syntax-rule (with-pypi responses body ...)
(display (foo-json #:name "foo-99") (display (foo-json #:name "foo-99")
port)))) port))))
(match (pypi->guix-package "foo-99") (match (pypi->guix-package "foo-99")
(('package (`(package
('name "python-foo-99") (name "python-foo-99")
('version "1.0.0") (version "1.0.0")
('source ('origin (source (origin
('method 'url-fetch) (method url-fetch)
('uri ('pypi-uri "foo-99" 'version)) (uri (pypi-uri "foo-99" version))
('sha256 (sha256
('base32 (base32 ,(? string? hash)))))
(? string? hash))))) (properties (quote (("upstream-name" . "foo-99"))))
('properties ('quote (("upstream-name" . "foo-99")))) (build-system pyproject-build-system)
('build-system 'pyproject-build-system) (propagated-inputs (list python-bar python-foo))
('propagated-inputs ('list 'python-bar 'python-foo)) (native-inputs (list python-pytest))
('native-inputs ('list 'python-pytest)) (home-page "http://example.com")
('home-page "http://example.com") (synopsis "summary")
('synopsis "summary") (description "summary")
('description "summary") (license license:lgpl2.0))
('license 'license:lgpl2.0))
(string=? default-sha256/base32 hash)) (string=? default-sha256/base32 hash))
(x (x
(pk 'fail x #f)))))) (pk 'fail x #f))))))

38
tests/texlive.scm
View file

@ -174,27 +174,27 @@ (define %fake-tlpdb
#:package-database #:package-database
(lambda _ %fake-tlpdb)))) (lambda _ %fake-tlpdb))))
(match result (match result
(('package (`(package
('inherit ('simple-texlive-package (inherit (simple-texlive-package
"texlive-texsis" "texlive-texsis"
('list "bibtex/bst/texsis/" (list "bibtex/bst/texsis/"
"doc/man/man1/" "doc/man/man1/"
"doc/otherformats/texsis/base/" "doc/otherformats/texsis/base/"
"tex/texsis/base/" "tex/texsis/base/"
"tex/texsis/config/") "tex/texsis/config/")
('base32 (? string? hash)) (base32 ,(? string? hash))
#:trivial? #t)) #:trivial? #t))
('version . any) (version ,_)
('propagated-inputs (propagated-inputs
('list 'texlive-cm (list texlive-cm
'texlive-hyphen-base texlive-hyphen-base
'texlive-knuth-lib texlive-knuth-lib
'texlive-plain texlive-plain
'texlive-tex)) texlive-tex))
('home-page (? string?)) (home-page ,(? string?))
('synopsis (? string?)) (synopsis ,(? string?))
('description (? string?)) (description ,(? string?))
('license 'lppl)) (license lppl))
#true) #true)
(_ (_
(begin (begin