summary refs log tree commit diff
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-pink 1.4.1 (git 2.36.1) at 2024-12-26 08:56:51 +0000