tests: Mock up http-fetch.

This is a follow-up to commit 63773200d7.

* tests/cpan.scm ("cpan->guix-package"): Add mock definition of
http-fetch.
This commit is contained in:
Ricardo Wurmus 2016-12-18 13:38:01 +01:00
parent e69c1a5446
commit 662a1aa6b0
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
1 changed files with 35 additions and 28 deletions

View File

@ -68,37 +68,44 @@
(lambda () (lambda ()
(display (display
(match url (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" ("http://example.com/Foo-Bar-0.1.tar.gz"
test-source) test-source)
(_ (error "Unexpected URL: " url)))))))) (_ (error "Unexpected URL: " url))))))))
(match (cpan->guix-package "Foo::Bar") (mock ((guix http-client) http-fetch
(('package (lambda (url)
('name "perl-foo-bar") (match url
('version "0.1") ("https://api.metacpan.org/release/Foo-Bar"
('source ('origin (values (open-input-string test-json)
('method 'url-fetch) (string-length test-json)))
('uri ('string-append "http://example.com/Foo-Bar-" ("https://api.metacpan.org/module/Test::Script?fields=distribution"
'version ".tar.gz")) (let ((result "{ \"distribution\" : \"Test-Script\" }"))
('sha256 (values (open-input-string result)
('base32 (string-length result))))
(? string? hash))))) (_ (error "Unexpected URL: " url)))))
('build-system 'perl-build-system) (match (cpan->guix-package "Foo::Bar")
('inputs (('package
('quasiquote ('name "perl-foo-bar")
(("perl-test-script" ('unquote 'perl-test-script))))) ('version "0.1")
('home-page "http://search.cpan.org/dist/Foo-Bar") ('source ('origin
('synopsis "Fizzle Fuzz") ('method 'url-fetch)
('description 'fill-in-yourself!) ('uri ('string-append "http://example.com/Foo-Bar-"
('license (package-license perl))) 'version ".tar.gz"))
(string=? (bytevector->nix-base32-string ('sha256
(call-with-input-string test-source port-sha256)) ('base32
hash)) (? string? hash)))))
(x ('build-system 'perl-build-system)
(pk 'fail x #f))))) ('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" (test-equal "source-url-http"
((@@ (guix import cpan) cpan-source-url) ((@@ (guix import cpan) cpan-source-url)