me
/
guix
Archived
1
0
Fork 0

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'.
master
Ludovic Courtès 2020-01-15 18:35:14 +01:00
parent 69f132554c
commit 4aea90b187
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 43 additions and 50 deletions

View File

@ -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)

View File

@ -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"