tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00
Code Activity

tests: don't use 'file://...' URIs for testing git downloads.

Browse Source 
While 'url-fetch*' in (guix download) special-cases these URIs, 'git-fetch'
does not.  Consequently, the recent changes to (guix scripts perform-download)
that disallow these URIs cause tests that use builtin:git-download to fail.

* guix/tests/git.scm (serve-git-repository, call-with-served-git-repository):
  new procedures.
  (with-served-git-repository, with-served-temporary-git-repository): new
  syntax.
* .dir-locals.el (scheme-mode): add indentation information for
  'with-served-git-repository'.
* tests/builders.scm ("git-fetch, file URI"): use git:// URI with
  'with-served-temporary-git-repository'.
* tests/derivations.scm ("'git-download' build-in builder, invalid hash",
  "'git-download' built-in builder, invalid commit", "'git-download' built-in
  builder, not found"): same.
  ("'git-download' built-in builder"): same, and use a nonce in the repo
  contents so that success isn't cached.

Change-Id: Id3e1233bb74d5987faf89c4341e1d37f09c77c80
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Reepca Russelstein
2025-09-16 22:08:19 -05:00
committed by Ludovic Courtès
parent b39f914b3e
commit 55a10ce4e6
4 changed files with 107 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
tests/derivations.scm
View File

@@ -306,12 +306,14 @@
get-string-all)
text))))))
(define %nonce (random-text))
(test-equal "'git-download' built-in builder"
`(("/a.txt" . "AAA")
`(("/a.txt" . ,%nonce)
("/b.scm" . "#t"))
(let ((nonce (random-text)))
(with-temporary-git-repository directory
`((add "a.txt" "AAA")
(with-served-temporary-git-repository directory port
`((add "a.txt" ,%nonce)
(add "b.scm" "#t")
(commit ,nonce))
(let* ((commit (with-repository directory repository
@@ -322,7 +324,9 @@
#:env-vars
`(("url"
. ,(object->string
(string-append "file://" directory)))
(string-append "git://localhost:"
(number->string port)
"/")))
("commit" . ,commit))
#:hash-algo 'sha256
#:hash (file-hash* directory
@@ -335,7 +339,7 @@
(directory-contents (derivation->output-path drv) get-string-all)))))
(test-assert "'git-download' built-in builder, invalid hash"
(with-temporary-git-repository directory
(with-served-temporary-git-repository directory port
`((add "a.txt" "AAA")
(add "b.scm" "#t")
(commit "Commit!"))
@@ -347,7 +351,9 @@
#:env-vars
`(("url"
. ,(object->string
(string-append "file://" directory)))
(string-append "git://localhost:"
(number->string port)
"/")))
("commit" . ,commit))
#:hash-algo 'sha256
#:hash (gcrypt:sha256 #vu8())
@@ -358,7 +364,7 @@
#f))))
(test-assert "'git-download' built-in builder, invalid commit"
(with-temporary-git-repository directory
(with-served-temporary-git-repository directory port
`((add "a.txt" "AAA")
(add "b.scm" "#t")
(commit "Commit!"))
@@ -367,7 +373,9 @@
#:env-vars
`(("url"
. ,(object->string
(string-append "file://" directory)))
(string-append "git://localhost:"
(number->string port)
"/")))
("commit"
. "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))
#:hash-algo 'sha256
@@ -379,19 +387,24 @@
#f))))
(test-assert "'git-download' built-in builder, not found"
(let* ((drv (derivation %store "git-download"
"builtin:git-download" '()
#:env-vars
`(("url" . "file:///does-not-exist.git")
("commit"
. "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))
#:hash-algo 'sha256
#:hash (gcrypt:sha256 #vu8())
#:recursive? #t)))
(guard (c ((store-protocol-error? c)
(string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv))
#f)))
(with-served-temporary-git-repository directory port
'()
(let* ((drv (derivation %store "git-download"
"builtin:git-download" '()
#:env-vars
`(("url" . ,(object->string
(string-append "git://localhost:"
(number->string port)
"/nonexistent")))
("commit"
. "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))
#:hash-algo 'sha256
#:hash (gcrypt:sha256 #vu8())
#:recursive? #t)))
(guard (c ((store-protocol-error? c)
(string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv))
#f))))
(test-equal "derivation-name"
"foo-0.0"