me
/
guix
Archived
1
0
Fork 0
Code

tests: Adjust to (guix import github) changes. 

This is a followup to a8d3033da6.

* tests/import-github.scm (call-with-releases): Mock
'open-connection-for-uri'.
master
Ludovic Courtès 2022-03-07 21:19:57 +01:00
parent 34ba6e0616
commit 667f21aea0
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 26 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
tests/import-github.scm
View File

@ -26,28 +26,37 @@
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix tests) #:use-module (guix tests)
#:use-module (guix upstream) #:use-module (guix upstream)
#:use-module (web uri)
#:use-module (ice-9 match)) #:use-module (ice-9 match))
(test-begin "github") (test-begin "github")
(define (call-with-releases thunk tags releases) (define (call-with-releases thunk tags releases)
(mock ((guix http-client) http-fetch (mock ((guix build download) open-connection-for-uri
(lambda* (uri #:key headers) (lambda _
(unless (string-prefix? "mock://" uri) ;; Return a fake socket.
(error "the URI ~a should not be used" uri)) (%make-void-port "w+0")))
(define components (mock ((guix http-client) http-fetch
(string-split (substring uri 8) #\/)) (lambda* (uri #:key headers #:allow-other-keys)
(pk 'stuff components headers) (let ((uri (if (string? uri)
(define (scm->json-port scm) (string->uri uri)
(open-input-string (scm->json-string scm))) uri)))
(match components (unless (eq? 'mock (uri-scheme uri))
(("repos" "foo" "foomatics" "releases") (error "the URI ~a should not be used" uri))
(scm->json-port releases)) (define components
(("repos" "foo" "foomatics" "tags") (string-tokenize (uri-path uri)
(scm->json-port tags)) (char-set-complement (char-set #\/))))
(rest (error "TODO ~a" rest))))) (pk 'stuff components headers)
(parameterize ((%github-api "mock://")) (define (scm->json-port scm)
(thunk)))) (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 ;; Copied from tests/minetest.scm
(define (upstream-source->sexp upstream-source) (define (upstream-source->sexp upstream-source)