Package: guix-patches;
Reported by: Nicolas Graves <ngraves <at> ngraves.fr>
Date: Wed, 15 Mar 2023 12:49:01 UTC
Severity: normal
Tags: moreinfo, patch
View this message in rfc822 format
From: Nicolas Graves <ngraves <at> ngraves.fr> To: Ludovic Courtès <ludo <at> gnu.org> Cc: zimoun.toutoune <at> gmail.com, 62202 <at> debbugs.gnu.org Subject: [bug#62202] [PATCH v4 6/6] tests: juliahub: Add unit tests for (guix import juliahub). Date: Thu, 11 Apr 2024 12:56:58 +0200
On 2024-04-09 09:29, Nicolas Graves wrote:
> On 2024-04-01 22:50, Ludovic Courtès wrote:
>
>> Hi,
>>
>> As part of this v4, I would recommend merging patches 2, 3, and 6, such
>> that there’s a single self-contained patch adding ‘guix import
>> juliahub’. (That’s what we usually do and I find it clearer because we
>> immediately see what goes together.)
>>
>> Nicolas Graves <ngraves <at> ngraves.fr> skribis:
>>
>>> * tests/juliahub.scm : Add unit tests juliahub-redirect,
>>> julia-general-registry-parsing, juliahub-fetch.
>>
>> Just “New file.”
>>
>> Some of the other files lack a commit log; we can add it for you, but
>> it’d be great if you could do it upfront.
>>
>>> ---
>>> tests/juliahub.scm | 185 +++++++++++++++++++++++++++++++++++++++++++++
>>
>> Please add it to ‘Makefile.am’.
>>
>> [...]
>>
>>> +(define (mock-http-fetch testcase)
>>> + (lambda (url . rest)
>>> + (let ((body (assoc-ref testcase url)))
>>> + (if body
>>> + (open-input-string body)
>>> + (error "mocked http-fetch Unexpected URL: " url)))))
>>> +
>>> +(define (mock-http-get testcase)
>>> + (lambda (url . rest)
>>> + (let ((body (assoc-ref testcase url))
>>> + (response-header
>>> + (build-response
>>> + #:version '(1 . 1)
>>
>> I strongly encourage using ‘with-http-server’ using the same strategy
>> that’s used in ‘tests/pypi.scm’ and others instead of mocking. (‘mock’
>> is very sensitive to inlining, plus you sorta have to make assumptions
>> about the code path to be able to mock the right things.)
>
> I can't however mock a git server, right? I still must mock at least the
> git repo instead of getting it through a custom server, or is there a
> better solution here?
It's actually simpler than I thought, but there's an impediment in guile
http server implementation that doesn't allow me to push this effort to
the end.
https://git-scm.com/book/en/v2/Git-Internals-Transfer-Protocols
I'm currently writing it, it'll result in a handy helper for tests, such
as :
(with-git-forge ; spawns a dumb but functional git server
'(("MyPackage" . ((add "a.txt" "A")
(commit "First commit")
(tag "v1.0.0" "Release 1.0"))))
(with-julia-test-servers
`(("/juliahub/MyPackage/" 200 ,juliahub-redirect.html)
("/juliahub/MyPackage/" 200 ,juliahub-redirect.html)
("/juliahub/MyPackage/MySlg/1.0.0/pkg.json" 200
,(lambda (port) (display (fixture-pkg.json) port)))
("/general/M/MyPackage/Package.toml" 200
,(lambda (port) (display (pk 'd (general-Package.toml)) port))))
(juliahub->guix-package "MyPackage")))
However, for that I'll need the http server to be able to respond with a
(content-type . (application/x-git-upload-pack-advertisement))
header to git. But in guile's web server implementation, this is not
possible because of sanitize-response's charset addition, which is not
configurable.
That's outside my field, how can we progress further ? We do indeed need
such a server to properly test juliahub since we go get the tag from the
actual repo (this is justified in the patch series).
_____________________________________________________________________________
;;; Git Forge = Git HTTP Server with Dump transfer protocol and repositories
(define (call-with-temporary-git-repositories names+directives proc)
"Call PROC with populated git temporary directories as per NAMES+DIRECTIVES;
close the directories and delete them when leaving the dynamic extent of this
call."
(call-with-temporary-directory
(lambda (directory)
(for-each
(match-lambda
((name . directives)
(populate-git-repository
(string-append directory "/" name ".git") directives)))
names+directives)
(proc directory))))
(define %git-forge-port
;; TCP port to use for the dumb git server.
;; If 0, the OS will automatically choose
;; a port.
(make-parameter 0))
(define (binary-file-dump file)
"Return a procedure that dumps binary FILE to the given port."
(lambda (output)
(call-with-input-file file
(lambda (input)
(put-bytevector output (get-bytevector-all input)))
#:binary #t)))
(define (serialize-git-ref ref oid)
(format #f "~a ~a\n" oid ref))
(define (refs->alist repo refs)
(let ((repository (repository-open repo)))
(map
(lambda (ref)
(cons ref (oid->string (reference-name->oid repository ref))))
refs)))
(define* (call-with-git-forge repositories+directives thunk)
"Call THUNK with a running GIT test forge, i.e. an HTTP server implementing
the git dumb protocol (see
https://git-scm.com/book/en/v2/Git-Internals-Transfer-Protocols) running.
This server behaves like a GIT forge with the repositories constructed from
REPOSITORIES+DIRECTIVES. Each element of REPOSITORIES+DIRECTIVES must be a
tuple containing a repository name and a list of DIRECTIVES.
%git-forge-port will be set to the port listened at
The port listened at will be set for the dynamic extent of THUNK."
(call-with-temporary-git-repositories
repositories+directives
(lambda (dir-with-repos)
(define responses+data
(let ((repos (scandir dir-with-repos
(lambda (name)
(not (member name '("." "..")))))))
(append-map
(lambda (relative-repo)
(let* ((name (string-drop-right relative-repo (string-length ".git")))
(repo (string-append dir-with-repos "/" relative-repo)))
`((,(string-append "/" name ".git/info/refs")
200
((content-type . (application/x-git-upload-pack-advertisement)))
,((@ (gnu services configuration) generic-serialize-alist)
string-append
serialize-git-ref
(refs->alist repo (remote-refs repo))))
(,(string-append "/" name ".git/HEAD")
200
"ref: refs/heads/master")
,@(map
(lambda (object)
`(,(string-append "/" name ".git/objects/"
(string-take-right object 41))
200
,(binary-file-dump
(string-append repo "/.git/objects/" object))))
(find-files (string-append repo "/.git/objects")))
(,(string-append "/" name ".git/objects/info/http-alternates")
200
"")
(,(string-append "/" name ".git/objects/info/packs")
200 ""))))
repos)))
(parameterize ((%http-server-port (%git-forge-port)))
(call-with-http-server (pk 'responses+data responses+data) thunk)))))
(define-syntax with-git-forge
(syntax-rules ()
((_ repositories+directives body ...)
(call-with-git-forge repositories+directives (lambda () body ...)))))
__________________________________________________________________________________
>>
>>> +(test-equal "juliahub-fetch"
>>> + #t
>>> + (mock ((web client) http-get
>>> + (mock-http-get fixtures-juliahub-check-test))
>>> + (mock ((guix http-client) http-fetch
>>> + (mock-http-fetch fixtures-juliahub-check-test))
>>> + (mock ((guix import utils) git->origin mock-git->origin)
>>> + ((@@ (guix import juliahub) juliahub-package?)
>>> + ((@@ (guix import juliahub) juliahub-fetch) "MyPackage"))))))
>>
>> Checking for ‘juliahub-package?’ doesn’t tell us much; what about
>> checking the whole package, similar to what is done in other importer
>> tests?
>>
>> Thanks,
>> Ludo’.
--
Best regards,
Nicolas Graves
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.