diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2023-09-11 15:28:09 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2023-09-26 17:36:58 +0200 |
| commit | 13b0cf85eb31e1b1ea674debbbfb0f35a32d1374 (patch) | |
| tree | d8560901ccd8d540f05dc342532d183e7ddb418f /tests | |
| parent | c4a1d69a6966aea71114c1aba0eab161139ff6fe (diff) | |
git-download: Use “builtin:git-download” when available.
Fixes <https://issues.guix.gnu.org/63331>.
Longer-term this will remove Git from the derivation graph when its sole
use is to perform a checkout for a fixed-output derivation, thereby
breaking dependency cycles that can arise in these situations.
* guix/git-download.scm (git-fetch): Rename to…
(git-fetch/in-band): … this. Deal with GIT or GUILE being #f.
(git-fetch/built-in, built-in-builders*, git-fetch): New procedures.
* tests/builders.scm ("git-fetch, file URI"): New test.
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/builders.scm | 29 |
1 files changed, 28 insertions, 1 deletions
diff --git a/tests/builders.scm b/tests/builders.scm index 0b5577c7a3c..619caa5f313 100644 --- a/tests/builders.scm +++ b/tests/builders.scm | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2018, 2019, 2021 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2012-2015, 2018-2019, 2021, 2023 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net> | 3 | ;;; Copyright © 2021 Lars-Dominik Braun <lars@6xq.net> |
| 4 | ;;; | 4 | ;;; |
| 5 | ;;; This file is part of GNU Guix. | 5 | ;;; This file is part of GNU Guix. |
| @@ -20,6 +20,7 @@ | |||
| 20 | 20 | ||
| 21 | (define-module (tests builders) | 21 | (define-module (tests builders) |
| 22 | #:use-module (guix download) | 22 | #:use-module (guix download) |
| 23 | #:use-module (guix git-download) | ||
| 23 | #:use-module (guix build-system) | 24 | #:use-module (guix build-system) |
| 24 | #:use-module (guix build-system gnu) | 25 | #:use-module (guix build-system gnu) |
| 25 | #:use-module (guix build gnu-build-system) | 26 | #:use-module (guix build gnu-build-system) |
| @@ -31,9 +32,12 @@ | |||
| 31 | #:use-module (guix base32) | 32 | #:use-module (guix base32) |
| 32 | #:use-module (guix derivations) | 33 | #:use-module (guix derivations) |
| 33 | #:use-module (gcrypt hash) | 34 | #:use-module (gcrypt hash) |
| 35 | #:use-module ((guix hash) #:select (file-hash*)) | ||
| 34 | #:use-module (guix tests) | 36 | #:use-module (guix tests) |
| 37 | #:use-module (guix tests git) | ||
| 35 | #:use-module (guix packages) | 38 | #:use-module (guix packages) |
| 36 | #:use-module (gnu packages bootstrap) | 39 | #:use-module (gnu packages bootstrap) |
| 40 | #:use-module ((ice-9 ftw) #:select (scandir)) | ||
| 37 | #:use-module (ice-9 match) | 41 | #:use-module (ice-9 match) |
| 38 | #:use-module (ice-9 textual-ports) | 42 | #:use-module (ice-9 textual-ports) |
| 39 | #:use-module (srfi srfi-1) | 43 | #:use-module (srfi srfi-1) |
| @@ -84,6 +88,29 @@ | |||
| 84 | (and (file-exists? out) | 88 | (and (file-exists? out) |
| 85 | (valid-path? %store out)))) | 89 | (valid-path? %store out)))) |
| 86 | 90 | ||
| 91 | (test-equal "git-fetch, file URI" | ||
| 92 | '("." ".." "a.txt" "b.scm") | ||
| 93 | (let ((nonce (random-text))) | ||
| 94 | (with-temporary-git-repository directory | ||
| 95 | `((add "a.txt" ,nonce) | ||
| 96 | (add "b.scm" "#t") | ||
| 97 | (commit "Commit.") | ||
| 98 | (tag "v1.0.0" "The tag.")) | ||
| 99 | (run-with-store %store | ||
| 100 | (mlet* %store-monad ((hash | ||
| 101 | -> (file-hash* directory | ||
| 102 | #:algorithm (hash-algorithm sha256) | ||
| 103 | #:recursive? #t)) | ||
| 104 | (drv (git-fetch | ||
| 105 | (git-reference | ||
| 106 | (url (string-append "file://" directory)) | ||
| 107 | (commit "v1.0.0")) | ||
| 108 | 'sha256 hash | ||
| 109 | "git-fetch-test"))) | ||
| 110 | (mbegin %store-monad | ||
| 111 | (built-derivations (list drv)) | ||
| 112 | (return (scandir (derivation->output-path drv))))))))) | ||
| 113 | |||
| 87 | (test-assert "gnu-build-system" | 114 | (test-assert "gnu-build-system" |
| 88 | (build-system? gnu-build-system)) | 115 | (build-system? gnu-build-system)) |
| 89 | 116 | ||
