@@ -2,6 +2,7 @@
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -31,8 +32,9 @@
;; Globally disable grafts because they can trigger early builds.
(%graft? #f)
-(define test-json
- "{
+(define (test-json)
+ (string-append
+ "{
\"metadata\" : {
\"name\" : \"Foo-Bar\",
\"version\" : \"0.1\"
@@ -50,10 +52,10 @@
}
],
\"abstract\" : \"Fizzle Fuzz\",
- \"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\",
+ \"download_url\" : \"" (%local-url* "/Foo-Bar-0.1.tar.gz") "\"
\"author\" : \"Guix\",
\"version\" : \"0.1\"
-}")
+}"))
(define test-source
"foobar")
@@ -62,18 +64,19 @@
(test-assert "cpan->guix-package"
;; Replace network resources with sample data.
- (with-http-server `((200 ,test-json)
- (200 ,test-source)
- (200 "{ \"distribution\" : \"Test-Script\" }"))
- (parameterize ((%metacpan-base-url (%local-url))
- (current-http-proxy (%local-url)))
+ (with-http-server `(("/release/Foo-Bar" 200 ,(test-json))
+ ("/Foo-Bar-0.1.tar.gz" 200 ,test-source)
+ ("/module/Test::Script?fields=distribution"
+ 200 "{ \"distribution\" : \"Test-Script\" }"))
+ (parameterize ((%metacpan-base-url (%local-url* ""))
+ (current-http-proxy #false))
(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-"
+ ('uri ('string-append (? string? base-uri)
'version ".tar.gz"))
('sha256
('base32
@@ -86,9 +89,10 @@
('synopsis "Fizzle Fuzz")
('description 'fill-in-yourself!)
('license 'perl-license))
- (string=? (bytevector->nix-base32-string
- (call-with-input-string test-source port-sha256))
- hash))
+ (and (string=? base-uri (%local-url* "/Foo-Bar-"))
+ (string=? (bytevector->nix-base32-string
+ (call-with-input-string test-source port-sha256))
+ hash)))
(x
(pk 'fail x #f))))))