[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
06/06: import: cpan: Rewrite tests to use an HTTP server instead of mock
From: |
guix-commits |
Subject: |
06/06: import: cpan: Rewrite tests to use an HTTP server instead of mocking. |
Date: |
Wed, 15 Jan 2020 12:41:22 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit 4aea90b1876179aab8d603a42533a6bdf97ccd3c
Author: Ludovic Courtès <address@hidden>
AuthorDate: Wed Jan 15 18:35:14 2020 +0100
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'.
---
guix/import/cpan.scm | 12 ++++++--
tests/cpan.scm | 81 ++++++++++++++++++++++------------------------------
2 files changed, 43 insertions(+), 50 deletions(-)
diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm
index 4320f94..7a97c7f 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 043d401..b4db9e6 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"
- branch master updated (44ce3eb -> 4aea90b), guix-commits, 2020/01/15
- 01/06: substitute: 'http-multiple-get' processes each request only once., guix-commits, 2020/01/15
- 02/06: gnu: Remove unnecessary uses of (guix build utils)., guix-commits, 2020/01/15
- 03/06: Avoid warnings for the 'delete' binding of (guix build utils)., guix-commits, 2020/01/15
- 05/06: import: cpan: Rewrite to use 'define-json-mapping'., guix-commits, 2020/01/15
- 04/06: More module autoload adjustments., guix-commits, 2020/01/15
- 06/06: import: cpan: Rewrite tests to use an HTTP server instead of mocking.,
guix-commits <=