aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/cpan.scm73
-rw-r--r--tests/crate.scm103
-rw-r--r--tests/derivations.scm27
-rw-r--r--tests/gem.scm10
-rw-r--r--tests/gexp.scm23
-rw-r--r--tests/graph.scm17
-rw-r--r--tests/guix-environment.sh17
-rw-r--r--tests/guix-package.sh10
-rw-r--r--tests/packages.scm3
-rw-r--r--tests/profiles.scm18
-rw-r--r--tests/pypi.scm159
-rw-r--r--tests/scripts-build.scm13
12 files changed, 347 insertions, 126 deletions
diff --git a/tests/cpan.scm b/tests/cpan.scm
index e37fc437fc..0c28a74d3e 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -68,46 +68,55 @@
(lambda ()
(display
(match url
- ("https://api.metacpan.org/release/Foo-Bar"
- test-json)
- ("https://api.metacpan.org/module/Test::Script"
- "{ \"distribution\" : \"Test-Script\" }")
("http://example.com/Foo-Bar-0.1.tar.gz"
test-source)
(_ (error "Unexpected URL: " 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)
- ('inputs
- ('quasiquote
- (("perl-test-script" ('unquote 'perl-test-script)))))
- ('home-page "http://search.cpan.org/dist/Foo-Bar")
- ('synopsis "Fizzle Fuzz")
- ('description 'fill-in-yourself!)
- ('license (package-license perl)))
- (string=? (bytevector->nix-base32-string
- (call-with-input-string test-source port-sha256))
- hash))
- (x
- (pk 'fail x #f)))))
+ (mock ((guix http-client) http-fetch
+ (lambda (url)
+ (match url
+ ("https://api.metacpan.org/release/Foo-Bar"
+ (values (open-input-string test-json)
+ (string-length test-json)))
+ ("https://api.metacpan.org/module/Test::Script?fields=distribution"
+ (let ((result "{ \"distribution\" : \"Test-Script\" }"))
+ (values (open-input-string result)
+ (string-length result))))
+ (_ (error "Unexpected URL: " 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)
+ ('inputs
+ ('quasiquote
+ (("perl-test-script" ('unquote 'perl-test-script)))))
+ ('home-page "http://search.cpan.org/dist/Foo-Bar")
+ ('synopsis "Fizzle Fuzz")
+ ('description 'fill-in-yourself!)
+ ('license (package-license perl)))
+ (string=? (bytevector->nix-base32-string
+ (call-with-input-string test-source port-sha256))
+ hash))
+ (x
+ (pk 'fail x #f))))))
(test-equal "source-url-http"
- ((@@ (guix import cpan) fix-source-url)
- "http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
+ ((@@ (guix import cpan) cpan-source-url)
+ `(("download_url" .
+ "http://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")))
"mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
(test-equal "source-url-https"
- ((@@ (guix import cpan) fix-source-url)
- "https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
+ ((@@ (guix import cpan) cpan-source-url)
+ `(("download_url" .
+ "https://cpan.metacpan.org/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")))
"mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz")
(test-end "cpan")
diff --git a/tests/crate.scm b/tests/crate.scm
new file mode 100644
index 0000000000..0bb344bb8a
--- /dev/null
+++ b/tests/crate.scm
@@ -0,0 +1,103 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 David Thompson <davet@gnu.org>
+;;; Copyright © 2016 David Craven <david@craven.ch>
+;;;
+;;; 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-crate)
+ #:use-module (guix import crate)
+ #:use-module (guix base32)
+ #:use-module (guix build-system cargo)
+ #:use-module (guix hash)
+ #:use-module (guix tests)
+ #:use-module (ice-9 iconv)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-64))
+
+(define test-crate
+ "{
+ \"crate\": {
+ \"max_version\": \"1.0.0\",
+ \"name\": \"foo\",
+ \"license\": \"MIT/Apache-2.0\",
+ \"description\": \"summary\",
+ \"homepage\": \"http://example.com\",
+ \"repository\": \"http://example.com\",
+ }
+}")
+
+(define test-dependencies
+ "{
+ \"dependencies\": [
+ {
+ \"crate_id\": \"bar\",
+ \"kind\": \"normal\",
+ }
+ ]
+}")
+
+(define test-source-hash
+ "")
+
+(test-begin "crate")
+
+(test-equal "guix-package->crate-name"
+ "rustc-serialize"
+ (guix-package->crate-name
+ (dummy-package
+ "rust-rustc-serialize"
+ (source (dummy-origin
+ (uri (crate-uri "rustc-serialize" "1.0")))))))
+
+(test-assert "crate->guix-package"
+ ;; Replace network resources with sample data.
+ (mock ((guix http-client) http-fetch
+ (lambda (url)
+ (match url
+ ("https://crates.io/api/v1/crates/foo"
+ (open-input-string test-crate))
+ ("https://crates.io/api/v1/crates/foo/1.0.0/download"
+ (set! test-source-hash
+ (bytevector->nix-base32-string
+ (sha256 (string->bytevector "empty file\n" "utf-8"))))
+ (open-input-string "empty file\n"))
+ ("https://crates.io/api/v1/crates/foo/1.0.0/dependencies"
+ (open-input-string test-dependencies))
+ (_ (error "Unexpected URL: " url)))))
+ (match (crate->guix-package "foo")
+ (('package
+ ('name "rust-foo")
+ ('version "1.0.0")
+ ('source ('origin
+ ('method 'url-fetch)
+ ('uri ('crate-uri "foo" 'version))
+ ('file-name ('string-append 'name "-" 'version ".tar.gz"))
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('build-system 'cargo-build-system)
+ ('inputs
+ ('quasiquote
+ (("rust-bar" ('unquote 'rust-bar) "src"))))
+ ('home-page "http://example.com")
+ ('synopsis "summary")
+ ('description "summary")
+ ('license ('list 'license:expat 'license:asl2.0)))
+ (string=? test-source-hash hash))
+ (x
+ (pk 'fail x #f)))))
+
+(test-end "crate")
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 2b5aa796d4..3fbfec3793 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -279,6 +279,27 @@
(build-derivations %store (list drv))
#f)))
+(unless (force %http-server-socket)
+ (test-skip 1))
+(test-assert "'download' built-in builder, check mode"
+ ;; Make sure rebuilding the 'builtin:download' derivation in check mode
+ ;; works. See <http://bugs.gnu.org/25089>.
+ (let* ((text (random-text))
+ (drv (derivation %store "world"
+ "builtin:download" '()
+ #:env-vars `(("url"
+ . ,(object->string (%local-url))))
+ #:hash-algo 'sha256
+ #:hash (sha256 (string->utf8 text)))))
+ (and (with-http-server 200 text
+ (build-derivations %store (list drv)))
+ (with-http-server 200 text
+ (build-derivations %store (list drv)
+ (build-mode check)))
+ (string=? (call-with-input-file (derivation->output-path drv)
+ get-string-all)
+ text))))
+
(test-equal "derivation-name"
"foo-0.0"
(let ((drv (derivation %store "foo-0.0" %bash '())))
@@ -1109,3 +1130,7 @@
(call-with-input-file out get-string-all))))
(test-end)
+
+;; Local Variables:
+;; eval: (put 'with-http-server 'scheme-indent-function 2)
+;; End:
diff --git a/tests/gem.scm b/tests/gem.scm
index a46c2b1439..669cd8ee60 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -45,13 +46,12 @@
(test-assert "gem->guix-package"
;; Replace network resources with sample data.
- (mock ((guix import utils) url-fetch
- (lambda (url file-name)
+ (mock ((guix http-client) http-fetch
+ (lambda (url)
(match url
("https://rubygems.org/api/v1/gems/foo.json"
- (with-output-to-file file-name
- (lambda ()
- (display test-json))))
+ (values (open-input-string test-json)
+ (string-length test-json)))
(_ (error "Unexpected URL: " url)))))
(match (gem->guix-package "foo")
(('package
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 354d28f014..baf78837ae 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -92,6 +92,16 @@
(package-derivation %store coreutils)))
(gexp->sexp* exp)))))
+(test-assert "one input package, dotted list"
+ (let ((exp (gexp (coreutils . (ungexp coreutils)))))
+ (and (gexp? exp)
+ (match (gexp-inputs exp)
+ (((p "out"))
+ (eq? p coreutils)))
+ (equal? `(coreutils . ,(derivation->output-path
+ (package-derivation %store coreutils)))
+ (gexp->sexp* exp)))))
+
(test-assert "one input origin"
(let ((exp (gexp (display (ungexp (package-source coreutils))))))
(and (gexp? exp)
@@ -277,6 +287,14 @@
(ungexp %bootstrap-guile)))))
(list (gexp-inputs exp) '<> (gexp-native-inputs exp))))
+(test-equal "ungexp + ungexp-native, nested, special mixture"
+ `(() <> ((,coreutils "out")))
+
+ ;; (gexp-native-inputs exp) used to return '(), wrongfully.
+ (let* ((foo (gexp (foo (ungexp-native coreutils))))
+ (exp (gexp (bar (ungexp foo)))))
+ (list (gexp-inputs exp) '<> (gexp-native-inputs exp))))
+
(test-assert "input list"
(let ((exp (gexp (display
'(ungexp (list %bootstrap-guile coreutils)))))
@@ -327,7 +345,8 @@
`(list ,@(cons 5 outputs))))))
(test-assert "input list splicing + ungexp-native-splicing"
- (let* ((inputs (list (gexp-input glibc "debug") %bootstrap-guile))
+ (let* ((inputs (list (gexp-input glibc "debug" #:native? #t)
+ %bootstrap-guile))
(exp (gexp (list (ungexp-native-splicing (cons (+ 2 3) inputs))))))
(and (lset= equal?
`((,glibc "debug") (,%bootstrap-guile "out"))
diff --git a/tests/graph.scm b/tests/graph.scm
index f2e441cee6..6431c482f7 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -32,6 +32,7 @@
#:use-module (gnu packages)
#:use-module (gnu packages base)
#:use-module (gnu packages guile)
+ #:use-module (gnu packages libunistring)
#:use-module (gnu packages bootstrap)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@@ -57,7 +58,8 @@ edges."
(define (return)
(values (reverse nodes) (reverse edges)))
- (values (graph-backend (const #t) (const #t)
+ (values (graph-backend "test" "This is the test backend."
+ (const #t) (const #t)
record-node record-edge)
return)))
@@ -91,6 +93,17 @@ edges."
(list p3 p3 p2)
(list p2 p1 p1))))))))
+(test-assert "reverse package DAG"
+ (let-values (((backend nodes+edges) (make-recording-backend)))
+ (run-with-store %store
+ (export-graph (list libunistring) 'port
+ #:node-type %reverse-package-node-type
+ #:backend backend))
+ ;; We should see nothing more than these 3 packages.
+ (let-values (((nodes edges) (nodes+edges)))
+ (and (member (package->tuple guile-2.0) nodes)
+ (->bool (member (edge->tuple libunistring guile-2.0) edges))))))
+
(test-assert "bag-emerged DAG"
(let-values (((backend nodes+edges) (make-recording-backend)))
(let* ((o (dummy-origin (method (lambda _
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index 68343520b0..2b3bbfe036 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -25,7 +25,8 @@ set -e
guix environment --version
tmpdir="t-guix-environment-$$"
-trap 'rm -r "$tmpdir"' EXIT
+gcroot="t-guix-environment-gc-root-$$"
+trap 'rm -r "$tmpdir"; rm -f "$gcroot"' EXIT
mkdir "$tmpdir"
@@ -61,6 +62,20 @@ fi
guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
-- "$SHELL" -c 'test -f "$GUIX_ENVIRONMENT/bin/guile"'
+# Make sure '-r' works as expected.
+rm -f "$gcroot"
+expected="`guix environment --bootstrap --ad-hoc guile-bootstrap \
+ -- "$SHELL" -c 'echo $GUIX_ENVIRONMENT'`"
+guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
+ -- guile -c 1
+test `readlink "$gcroot"` = "$expected"
+
+# Make sure '-r' is idempotent.
+guix environment --bootstrap -r "$gcroot" --ad-hoc guile-bootstrap \
+ -- guile -c 1
+test `readlink "$gcroot"` = "$expected"
+
+
case "`uname -m`" in
x86_64)
# On x86_64, we should be able to create a 32-bit environment.
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 68a1946aa0..5ecb33193f 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
#
# This file is part of GNU Guix.
@@ -39,6 +39,14 @@ trap 'rm -f "$profile" "$profile-"[0-9]* "$tmpfile"; rm -rf "$module_dir" t-home
if guix package --bootstrap -e +;
then false; else true; fi
+# Install a store item and make sure the version and output in the manifest
+# are correct.
+guix package --bootstrap -p "$profile" -i `guix build guile-bootstrap`
+test "`guix package -A guile-bootstrap | cut -f 1-2`" \
+ = "`guix package -p "$profile" -I | cut -f 1-2`"
+test "`guix package -p "$profile" -I | cut -f 3`" = "out"
+rm "$profile"
+
guix package --bootstrap -p "$profile" -i guile-bootstrap
test -L "$profile" && test -L "$profile-1-link"
test -f "$profile/bin/guile"
diff --git a/tests/packages.scm b/tests/packages.scm
index 47e76b53e9..247f75cc43 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -968,7 +968,8 @@
(profile-derivation
(manifest (map package->manifest-entry
(list p1 p2)))
- #:hooks '())
+ #:hooks '()
+ #:locales? #f)
#:guile-for-build (%guile-for-build))))
(build-derivations %store (list prof))
(string-match (format #f "^export XML_CATALOG_FILES=\"~a/xml/+bar/baz/catalog\\.xml\"\n"
diff --git a/tests/profiles.scm b/tests/profiles.scm
index f9c2f5499e..5536364889 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -195,7 +195,8 @@
((entry -> (package->manifest-entry %bootstrap-guile))
(guile (package->derivation %bootstrap-guile))
(drv (profile-derivation (manifest (list entry))
- #:hooks '()))
+ #:hooks '()
+ #:locales? #f))
(profile -> (derivation->output-path drv))
(bindir -> (string-append profile "/bin"))
(_ (built-derivations (list drv))))
@@ -207,7 +208,8 @@
(mlet* %store-monad
((entry -> (package->manifest-entry packages:glibc "debug"))
(drv (profile-derivation (manifest (list entry))
- #:hooks '())))
+ #:hooks '()
+ #:locales? #f)))
(return (derivation-inputs drv))))
(test-assert "package->manifest-entry defaults to \"out\""
@@ -228,7 +230,8 @@
(package-native-search-paths packages:guile-2.0))))
(entry -> (package->manifest-entry guile))
(drv (profile-derivation (manifest (list entry))
- #:hooks '()))
+ #:hooks '()
+ #:locales? #f))
(profile -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
@@ -259,7 +262,8 @@
(package-native-search-paths packages:guile-2.0))))
(entry -> (package->manifest-entry guile))
(drv (profile-derivation (manifest (list entry))
- #:hooks '()))
+ #:hooks '()
+ #:locales? #f))
(profile -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
@@ -293,7 +297,8 @@
(display "foo!" port))))))))
(entry -> (package->manifest-entry thing))
(drv (profile-derivation (manifest (list entry))
- #:hooks '()))
+ #:hooks '()
+ #:locales? #f))
(profile -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
@@ -321,7 +326,8 @@
(display "foo!" port))))))))
(entry -> (package->manifest-entry thing))
(drv (profile-derivation (manifest (list entry))
- #:hooks '()))
+ #:hooks '()
+ #:locales? #f))
(profile -> (derivation->output-path drv)))
(mbegin %store-monad
(built-derivations (list drv))
diff --git a/tests/pypi.scm b/tests/pypi.scm
index 9d2fcc7391..f26e7fea13 100644
--- a/tests/pypi.scm
+++ b/tests/pypi.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
+;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -91,51 +92,55 @@ baz > 13.37")
(test-assert "pypi->guix-package"
;; Replace network resources with sample data.
- (mock ((guix import utils) url-fetch
- (lambda (url file-name)
- (match url
- ("https://pypi.python.org/pypi/foo/json"
- (with-output-to-file file-name
- (lambda ()
- (display test-json))))
- ("https://example.com/foo-1.0.0.tar.gz"
- (begin
- (mkdir "foo-1.0.0")
- (with-output-to-file "foo-1.0.0/requirements.txt"
- (lambda ()
- (display test-requirements)))
- (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)))))
- (match (pypi->guix-package "foo")
- (('package
- ('name "python-foo")
- ('version "1.0.0")
- ('source ('origin
- ('method 'url-fetch)
- ('uri (string-append "https://example.com/foo-"
- version ".tar.gz"))
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'python-build-system)
- ('propagated-inputs
- ('quasiquote
- (("python-bar" ('unquote 'python-bar))
- ("python-baz" ('unquote 'python-baz))
- ("python-setuptools" ('unquote 'python-setuptools)))))
- ('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)))))
+ (mock ((guix import utils) url-fetch
+ (lambda (url file-name)
+ (match url
+ ("https://example.com/foo-1.0.0.tar.gz"
+ (begin
+ (mkdir "foo-1.0.0")
+ (with-output-to-file "foo-1.0.0/requirements.txt"
+ (lambda ()
+ (display test-requirements)))
+ (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)
+ (match url
+ ("https://pypi.python.org/pypi/foo/json"
+ (values (open-input-string test-json)
+ (string-length test-json)))
+ ("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 (string-append "https://example.com/foo-"
+ version ".tar.gz"))
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('build-system 'python-build-system)
+ ('propagated-inputs
+ ('quasiquote
+ (("python-bar" ('unquote 'python-bar))
+ ("python-baz" ('unquote 'python-baz))
+ ("python-setuptools" ('unquote 'python-setuptools)))))
+ ('home-page "http://example.com")
+ ('synopsis "summary")
+ ('description "summary")
+ ('license 'license:lgpl2.0))
+ (string=? (bytevector->nix-base32-string
+ test-source-hash)
+ hash))
+ (x
+ (pk 'fail x #f))))))
(test-skip (if (which "zip") 0 1))
(test-assert "pypi->guix-package, wheels"
@@ -143,10 +148,6 @@ baz > 13.37")
(mock ((guix import utils) url-fetch
(lambda (url file-name)
(match url
- ("https://pypi.python.org/pypi/foo/json"
- (with-output-to-file file-name
- (lambda ()
- (display test-json))))
("https://example.com/foo-1.0.0.tar.gz"
(begin
(mkdir "foo-1.0.0")
@@ -170,31 +171,39 @@ baz > 13.37")
(rename-file zip-file file-name))
(delete-file-recursively "foo-1.0.0.dist-info")))
(_ (error "Unexpected URL: " url)))))
- (match (pypi->guix-package "foo")
- (('package
- ('name "python-foo")
- ('version "1.0.0")
- ('source ('origin
- ('method 'url-fetch)
- ('uri (string-append "https://example.com/foo-"
- version ".tar.gz"))
- ('sha256
- ('base32
- (? string? hash)))))
- ('build-system 'python-build-system)
- ('propagated-inputs
- ('quasiquote
- (("python-bar" ('unquote 'python-bar))
- ("python-baz" ('unquote 'python-baz))
- ("python-setuptools" ('unquote 'python-setuptools)))))
- ('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)))))
+ (mock ((guix http-client) http-fetch
+ (lambda (url)
+ (match url
+ ("https://pypi.python.org/pypi/foo/json"
+ (values (open-input-string test-json)
+ (string-length test-json)))
+ ("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 (string-append "https://example.com/foo-"
+ version ".tar.gz"))
+ ('sha256
+ ('base32
+ (? string? hash)))))
+ ('build-system 'python-build-system)
+ ('propagated-inputs
+ ('quasiquote
+ (("python-bar" ('unquote 'python-bar))
+ ("python-baz" ('unquote 'python-baz))
+ ("python-setuptools" ('unquote 'python-setuptools)))))
+ ('home-page "http://example.com")
+ ('synopsis "summary")
+ ('description "summary")
+ ('license 'license:lgpl2.0))
+ (string=? (bytevector->nix-base32-string
+ test-source-hash)
+ hash))
+ (x
+ (pk 'fail x #f))))))
(test-end "pypi")
diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm
index b324012806..a1f684c736 100644
--- a/tests/scripts-build.scm
+++ b/tests/scripts-build.scm
@@ -50,6 +50,19 @@
(add-to-store store "guix.scm" #t
"sha256" s)))))))
+(test-assert "options->transformation, with-source, replacement"
+ ;; Same, but this time the original package has a 'replacement' field. We
+ ;; expect that replacement to be set to #f in the new package.
+ (let* ((p (dummy-package "guix.scm" (replacement coreutils)))
+ (s (search-path %load-path "guix.scm"))
+ (t (options->transformation `((with-source . ,s)))))
+ (with-store store
+ (let ((new (t store p)))
+ (and (not (eq? new p))
+ (string=? (package-source new)
+ (add-to-store store "guix.scm" #t "sha256" s))
+ (not (package-replacement new)))))))
+
(test-assert "options->transformation, with-source, with version"
;; Our pseudo-package is called 'guix.scm' so the 'guix.scm-2.0' source
;; should be applicable, and its version should be extracted.
generated by cgit v1.2.3 (git 2.25.4) at 2024-10-12 09:24:37 +0000