ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

import: cpan: Rewrite tests to use an HTTP server instead of mocking.

Browse source 
* 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'.
This commit is contained in:
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
Show stats Download patch file Download diff file Expand all files Collapse all files

12
guix/import/cpan.scm
View file

@ -61,7 +61,9 @@ (define-module (guix import cpan)
cpan-fetch cpan-fetch
cpan->guix-package cpan->guix-package
metacpan-url->mirror-url metacpan-url->mirror-url
%cpan-updater)) %cpan-updater
%metacpan-base-url))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -70,6 +72,10 @@ (define-module (guix import cpan)
;;; ;;;
;;; Code: ;;; Code:
(define %metacpan-base-url
;; Base URL of the MetaCPAN API.
(make-parameter "https://fastapi.metacpan.org/v1/"))
;; Dependency of a "release". ;; Dependency of a "release".
(define-json-mapping <cpan-dependency> make-cpan-dependency cpan-dependency? (define-json-mapping <cpan-dependency> make-cpan-dependency cpan-dependency?
json->cpan-dependency json->cpan-dependency
@ -149,7 +155,7 @@ (define (module->dist-name module)
module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would
return \"Test-Simple\"" return \"Test-Simple\""
(assoc-ref (json-fetch (string-append (assoc-ref (json-fetch (string-append
"https://fastapi.metacpan.org/v1/module/" (%metacpan-base-url) "/module/"
module module
"?fields=distribution")) "?fields=distribution"))
"distribution")) "distribution"))
@ -176,7 +182,7 @@ (define (cpan-fetch name)
\"Test-Script\" for the \"Test::Script\" module." \"Test-Script\" for the \"Test::Script\" module."
;; This API always returns the latest release of the module. ;; This API always returns the latest release of the module.
(json->cpan-release (json->cpan-release
(json-fetch (string-append "https://fastapi.metacpan.org/v1/release/" (json-fetch (string-append (%metacpan-base-url) "/release/"
name)))) name))))
(define (cpan-home name) (define (cpan-home name)

81
tests/cpan.scm
View file

@ -22,9 +22,10 @@ (define-module (test-cpan)
#:use-module (guix import cpan) #:use-module (guix import cpan)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (gcrypt hash) #:use-module (gcrypt hash)
#:use-module (guix tests) #:use-module (guix tests http)
#:use-module (guix grafts) #:use-module (guix grafts)
#:use-module (srfi srfi-64) #:use-module (srfi srfi-64)
#:use-module (web client)
#:use-module (ice-9 match)) #:use-module (ice-9 match))
;; Globally disable grafts because they can trigger early builds. ;; Globally disable grafts because they can trigger early builds.
@ -57,56 +58,42 @@ (define test-json
(define test-source (define test-source
"foobar") "foobar")
;; Avoid collisions with other tests.
(%http-server-port 10400)
(test-begin "cpan") (test-begin "cpan")
(test-assert "cpan->guix-package" (test-assert "cpan->guix-package"
;; Replace network resources with sample data. ;; Replace network resources with sample data.
(mock ((guix build download) url-fetch (with-http-server `((200 ,test-json)
(lambda* (url file-name (200 ,test-source)
#:key (200 "{ \"distribution\" : \"Test-Script\" }"))
(mirrors '()) verify-certificate?) (parameterize ((%metacpan-base-url (%local-url))
(with-output-to-file file-name (current-http-proxy (%local-url)))
(lambda () (match (cpan->guix-package "Foo::Bar")
(display (('package
(match url ('name "perl-foo-bar")
("http://example.com/Foo-Bar-0.1.tar.gz" ('version "0.1")
test-source) ('source ('origin
(_ (error "Unexpected URL: " url)))))))) ('method 'url-fetch)
(mock ((guix http-client) http-fetch ('uri ('string-append "http://example.com/Foo-Bar-"
(lambda (url . rest) 'version ".tar.gz"))
(match url ('sha256
("https://fastapi.metacpan.org/v1/release/Foo-Bar" ('base32
(values (open-input-string test-json) (? string? hash)))))
(string-length test-json))) ('build-system 'perl-build-system)
("https://fastapi.metacpan.org/v1/module/Test::Script?fields=distribution" ('propagated-inputs
(let ((result "{ \"distribution\" : \"Test-Script\" }")) ('quasiquote
(values (open-input-string result) (("perl-test-script" ('unquote 'perl-test-script)))))
(string-length result)))) ('home-page "https://metacpan.org/release/Foo-Bar")
(_ (error "Unexpected URL: " url))))) ('synopsis "Fizzle Fuzz")
(match (cpan->guix-package "Foo::Bar") ('description 'fill-in-yourself!)
(('package ('license 'perl-license))
('name "perl-foo-bar") (string=? (bytevector->nix-base32-string
('version "0.1") (call-with-input-string test-source port-sha256))
('source ('origin hash))
('method 'url-fetch) (x
('uri ('string-append "http://example.com/Foo-Bar-" (pk 'fail x #f))))))
'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" (test-equal "metacpan-url->mirror-url, http"
"mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz" "mirror://cpan/authors/id/T/TE/TEST/Foo-Bar-0.1.tar.gz"