diff options
author | Leo Famulari <leo@famulari.name> | 2017-01-06 17:14:41 -0500 |
---|---|---|
committer | Leo Famulari <leo@famulari.name> | 2017-01-06 17:14:41 -0500 |
commit | 74288230ea8b2310495dc2739f39ceadcc143fd0 (patch) | |
tree | 73ba6c7c13d59c5f92b409c94dccfff159e08f4d /tests | |
parent | 92e779592d269ca1924f184496eb4ca832997b12 (diff) | |
parent | aa21c764d65068783ae31febee2a92eb3d138a24 (diff) | |
download | patches-74288230ea8b2310495dc2739f39ceadcc143fd0.tar patches-74288230ea8b2310495dc2739f39ceadcc143fd0.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r-- | tests/cpan.scm | 73 | ||||
-rw-r--r-- | tests/crate.scm | 103 | ||||
-rw-r--r-- | tests/gem.scm | 10 | ||||
-rw-r--r-- | tests/gexp.scm | 23 | ||||
-rw-r--r-- | tests/graph.scm | 17 | ||||
-rw-r--r-- | tests/guix-environment.sh | 17 | ||||
-rw-r--r-- | tests/lint.scm | 37 | ||||
-rw-r--r-- | tests/packages.scm | 3 | ||||
-rw-r--r-- | tests/profiles.scm | 18 | ||||
-rw-r--r-- | tests/pypi.scm | 159 | ||||
-rw-r--r-- | tests/scripts-build.scm | 13 | ||||
-rw-r--r-- | tests/store.scm | 9 |
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 |