mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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:
parent
e69c1a5446
commit
662a1aa6b0
1 changed files with 35 additions and 28 deletions
|
@ -68,37 +68,44 @@ (define test-source
|
|||
(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)
|
||||
|
|
Loading…
Reference in a new issue