From 662a1aa6b049d29977cfc376d4a185a3e8be4a07 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Sun, 18 Dec 2016 13:38:01 +0100 Subject: tests: Mock up http-fetch. This is a follow-up to commit 63773200d7ac68fcaee6efd9ffe8ea7aa3fafa38. * tests/cpan.scm ("cpan->guix-package"): Add mock definition of http-fetch. --- tests/cpan.scm | 63 ++++++++++++++++++++++++++++++++-------------------------- 1 file changed, 35 insertions(+), 28 deletions(-) (limited to 'tests/cpan.scm') diff --git a/tests/cpan.scm b/tests/cpan.scm index 56effc7201..0c28a74d3e 100644 --- a/tests/cpan.scm +++ b/tests/cpan.scm @@ -68,37 +68,44 @@ (lambda () (display (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" test-source) (_ (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) - ('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))))) + (mock ((guix http-client) http-fetch + (lambda (url) + (match url + ("https://api.metacpan.org/release/Foo-Bar" + (values (open-input-string test-json) + (string-length test-json))) + ("https://api.metacpan.org/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) + ('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" ((@@ (guix import cpan) cpan-source-url) -- cgit v1.2.3