summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-01-15 18:35:14 +0100
committerLudovic Courtès <ludo@gnu.org>2020-01-15 18:40:43 +0100
commit4aea90b1876179aab8d603a42533a6bdf97ccd3c (patch)
tree6b117f50914a9a927788360f53217e04a6d534cd
parent69f132554c6bd23df4610a21e636bde5f0578174 (diff)
downloadpatches-4aea90b1876179aab8d603a42533a6bdf97ccd3c.tar
patches-4aea90b1876179aab8d603a42533a6bdf97ccd3c.tar.gz
import: cpan: Rewrite tests to use an HTTP server instead of mocking.
* guix/import/cpan.scm (%metacpan-base-url): New variable. (module->dist-name, cpan-fetch): Refer to it instead of the hard-coded URL. * tests/cpan.scm ("cpan->guix-package"): Use 'with-http-server' instead of 'mock'.
-rw-r--r--guix/import/cpan.scm12
-rw-r--r--tests/cpan.scm81
2 files changed, 43 insertions, 50 deletions
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index 4320f94c98..7a97c7f8e8 100644
--- a/guix/import/cpan.scm
+++ b/guix/import/cpan.scm
@@ -61,7 +61,9 @@
cpan-fetch
cpan->guix-package
metacpan-url->mirror-url
- %cpan-updater))
+ %cpan-updater
+
+ %metacpan-base-url))
;;; Commentary:
;;;
@@ -70,6 +72,10 @@
;;;
;;; Code:
+(define %metacpan-base-url
+ ;; Base URL of the MetaCPAN API.
+ (make-parameter "https://fastapi.metacpan.org/v1/"))
+
;; Dependency of a "release".
(define-json-mapping <cpan-dependency> make-cpan-dependency cpan-dependency?
json->cpan-dependency
@@ -149,7 +155,7 @@
module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would
return \"Test-Simple\""
(assoc-ref (json-fetch (string-append
- "https://fastapi.metacpan.org/v1/module/"
+ (%metacpan-base-url) "/module/"
module
"?fields=distribution"))
"distribution"))
@@ -176,7 +182,7 @@ or #f on failure. MODULE should be the distribution name, such as
\"Test-Script\" for the \"Test::Script\" module."
;; This API always returns the latest release of the module.
(json->cpan-release
- (json-fetch (string-append "https://fastapi.metacpan.org/v1/release/"
+ (json-fetch (string-append (%metacpan-base-url) "/release/"
name))))
(define (cpan-home name)
diff --git a/tests/cpan.scm b/tests/cpan.scm
index 043d401032..b4db9e60e4 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -22,9 +22,10 @@
#:use-module (guix import cpan)
#:use-module (guix base32)
#:use-module (gcrypt hash)
- #:use-module (guix tests)
+ #:use-module (guix tests http)
#:use-module (guix grafts)
#:use-module (srfi srfi-64)
+ #:use-module (web client)
#:use-module (ice-9 match))
;; Globally disable grafts because they can trigger early builds.
@@ -57,56 +58,42 @@
(define test-source
"foobar")
+;; Avoid collisions with other tests.
+(%http-server-port 10400)
+
(test-begin "cpan")
(test-assert "cpan->guix-package"
;; Replace network resources with sample data.
- (mock ((guix build download) url-fetch
- (lambda* (url file-name
- #:key
- (mirrors '()) verify-certificate?)
- (with-output-to-file file-name
- (lambda ()
- (display
- (match url
- ("http://example.com/Foo-Bar-0.1.tar.gz"
- test-source)
- (_ (error "Unexpected URL: " url))))))))
- (mock ((guix http-client) http-fetch
- (lambda (url . rest)
- (match url
- ("https://fastapi.metacpan.org/v1/release/Foo-Bar"
- (values (open-input-string test-json)
- (string-length test-json)))
- ("https://fastapi.metacpan.org/v1/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)
- ('propagated-inputs
- ('quasiquote
- (("perl-test-script" ('unquote 'perl-test-script)))))
- ('home-page "https://metacpan.org/release/Foo-Bar")
- ('synopsis "Fizzle Fuzz")
- ('description 'fill-in-yourself!)
- ('license 'perl-license))
- (string=? (bytevector->nix-base32-string
- (call-with-input-string test-source port-sha256))
- hash))
- (x
- (pk 'fail x #f))))))
+ (with-http-server `((200 ,test-json)
+ (200 ,test-source)
+ (200 "{ \"distribution\" : \"Test-Script\" }"))
+ (parameterize ((%metacpan-base-url (%local-url))
+ (current-http-proxy (%local-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)
+ ('propagated-inputs
+ ('quasiquote
+ (("perl-test-script" ('unquote 'perl-test-script)))))
+ ('home-page "https://metacpan.org/release/Foo-Bar")
+ ('synopsis "Fizzle Fuzz")
+ ('description 'fill-in-yourself!)
+ ('license 'perl-license))
+ (string=? (bytevector->nix-base32-string
+ (call-with-input-string test-source port-sha256))
+ hash))
+ (x
+ (pk 'fail x #f))))))
(test-equal "metacpan-url->mirror-url, http"
"mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"