summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-03-07 21:19:57 +0100
committerLudovic Courtès <ludo@gnu.org>2022-03-07 22:49:27 +0100
commit667f21aea000b988f2587f9039be25e61a2cbb08 (patch)
treea71f241e127e32c2955efb4e6180aea537b024c9 /tests
parent34ba6e0616a4f8cee672ea23a9ed6fbb1b155a4b (diff)
tests: Adjust to (guix import github) changes.
This is a followup to a8d3033da61958c53c44dd5db90672bfc4533ef9. * tests/import-github.scm (call-with-releases): Mock 'open-connection-for-uri'.
Diffstat (limited to 'tests')
-rw-r--r--tests/import-github.scm43
1 files changed, 26 insertions, 17 deletions
diff --git a/tests/import-github.scm b/tests/import-github.scm
index 979a0fc12b..4d3f8cfc7e 100644
--- a/tests/import-github.scm
+++ b/tests/import-github.scm
@@ -26,28 +26,37 @@
#:use-module (guix packages)
#:use-module (guix tests)
#:use-module (guix upstream)
+ #:use-module (web uri)
#:use-module (ice-9 match))
(test-begin "github")
(define (call-with-releases thunk tags releases)
- (mock ((guix http-client) http-fetch
- (lambda* (uri #:key headers)
- (unless (string-prefix? "mock://" uri)
- (error "the URI ~a should not be used" uri))
- (define components
- (string-split (substring uri 8) #\/))
- (pk 'stuff components headers)
- (define (scm->json-port scm)
- (open-input-string (scm->json-string scm)))
- (match components
- (("repos" "foo" "foomatics" "releases")
- (scm->json-port releases))
- (("repos" "foo" "foomatics" "tags")
- (scm->json-port tags))
- (rest (error "TODO ~a" rest)))))
- (parameterize ((%github-api "mock://"))
- (thunk))))
+ (mock ((guix build download) open-connection-for-uri
+ (lambda _
+ ;; Return a fake socket.
+ (%make-void-port "w+0")))
+ (mock ((guix http-client) http-fetch
+ (lambda* (uri #:key headers #:allow-other-keys)
+ (let ((uri (if (string? uri)
+ (string->uri uri)
+ uri)))
+ (unless (eq? 'mock (uri-scheme uri))
+ (error "the URI ~a should not be used" uri))
+ (define components
+ (string-tokenize (uri-path uri)
+ (char-set-complement (char-set #\/))))
+ (pk 'stuff components headers)
+ (define (scm->json-port scm)
+ (open-input-string (scm->json-string scm)))
+ (match components
+ (("repos" "foo" "foomatics" "releases")
+ (scm->json-port releases))
+ (("repos" "foo" "foomatics" "tags")
+ (scm->json-port tags))
+ (rest (error "TODO ~a" rest))))))
+ (parameterize ((%github-api "mock://"))
+ (thunk)))))
;; Copied from tests/minetest.scm
(define (upstream-source->sexp upstream-source)