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/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/lint.scm37
-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
-rw-r--r--tests/store.scm9
12 files changed, 358 insertions, 124 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/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/lint.scm b/tests/lint.scm
index 0c534562a4..3a9b89fe95 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -34,6 +35,10 @@
#:use-module (gnu packages)
#:use-module (gnu packages glib)
#:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages python)
+ #:use-module (web server)
+ #:use-module (web server http)
+ #:use-module (web response)
#:use-module (ice-9 match)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-64))
@@ -274,6 +279,38 @@
(check-inputs-should-be-native pkg)))
"'glib:bin' should probably be a native input")))
+(test-assert
+ "inputs: python-setuptools should not be an input at all (input)"
+ (->bool
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (inputs `(("python-setuptools" ,python-setuptools))))))
+ (check-inputs-should-not-be-an-input-at-all pkg)))
+ "'python-setuptools' should probably not be an input at all")))
+
+(test-assert
+ "inputs: python-setuptools should not be an input at all (native-input)"
+ (->bool
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (native-inputs
+ `(("python-setuptools" ,python-setuptools))))))
+ (check-inputs-should-not-be-an-input-at-all pkg)))
+ "'python-setuptools' should probably not be an input at all")))
+
+(test-assert
+ "inputs: python-setuptools should not be an input at all (propagated-input)"
+ (->bool
+ (string-contains
+ (with-warnings
+ (let ((pkg (dummy-package "x"
+ (propagated-inputs
+ `(("python-setuptools" ,python-setuptools))))))
+ (check-inputs-should-not-be-an-input-at-all pkg)))
+ "'python-setuptools' should probably not be an input at all")))
+
(test-assert "patches: file names"
(->bool
(string-contains
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.
diff --git a/tests/store.scm b/tests/store.scm
index 38b8efce96..123ea8a787 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -48,6 +48,15 @@
(test-begin "store")
+(test-equal "connection handshake error"
+ EPROTO
+ (let ((port (%make-void-port "rw")))
+ (guard (c ((nix-connection-error? c)
+ (and (eq? port (nix-connection-error-file c))
+ (nix-connection-error-code c))))
+ (open-connection #f #:port port)
+ 'broken)))
+
(test-equal "store-path-hash-part"
"283gqy39v3g9dxjy26rynl0zls82fmcg"
(store-path-hash-part
generated by cgit v1.2.3 (git 2.45.0) at 2024-12-16 03:42:45 +0000