* [bug#30450] [PATCH] git-download: Fetch only the required commit, if possible.
@ 2018-02-13 23:54 Danny Milosavljevic
0 siblings, 0 replies; only message in thread
From: Danny Milosavljevic @ 2018-02-13 23:54 UTC (permalink / raw)
To: 30450
* guix/build/git.scm (git-fetch): Fetch only the required commit, if possible.
---
guix/build/git.scm | 43 +++++++++++++++++++++++--------------------
1 file changed, 23 insertions(+), 20 deletions(-)
diff --git a/guix/build/git.scm b/guix/build/git.scm
index c1af545a7..14d415a6f 100644
--- a/guix/build/git.scm
+++ b/guix/build/git.scm
@@ -37,28 +37,31 @@ recursively. Return #t on success, #f otherwise."
;; in advance anyway.
(setenv "GIT_SSL_NO_VERIFY" "true")
- ;; We cannot use "git clone --recursive" since the following "git checkout"
- ;; effectively removes sub-module checkouts as of Git 2.6.3.
- (and (zero? (system* git-command "clone" url directory))
- (with-directory-excursion directory
- (system* git-command "tag" "-l")
- (and (zero? (system* git-command "checkout" commit))
- (begin
- (when recursive?
- ;; Now is the time to fetch sub-modules.
- (unless (zero? (system* git-command "submodule" "update"
+ (mkdir-p directory)
+
+ (with-directory-excursion directory
+ (invoke git-command "init")
+ (invoke git-command "remote" "add" "origin" url)
+ (if (zero? (system* git-command "fetch" "--depth" "1" "origin" commit))
+ (invoke git-command "checkout" "FETCH_HEAD")
+ (begin
+ (invoke git-command "fetch" "origin")
+ (invoke git-command "checkout" commit)))
+ (when recursive?
+ ;; Now is the time to fetch sub-modules.
+ (unless (zero? (system* git-command "submodule" "update"
"--init" "--recursive"))
- (error "failed to fetch sub-modules" url))
+ (error "failed to fetch sub-modules" url))
- ;; In sub-modules, '.git' is a flat file, not a directory,
- ;; so we can use 'find-files' here.
- (for-each delete-file-recursively
- (find-files directory "^\\.git$")))
+ ;; In sub-modules, '.git' is a flat file, not a directory,
+ ;; so we can use 'find-files' here.
+ (for-each delete-file-recursively
+ (find-files directory "^\\.git$")))
- ;; The contents of '.git' vary as a function of the current
- ;; status of the Git repo. Since we want a fixed output, this
- ;; directory needs to be taken out.
- (delete-file-recursively ".git")
- #t)))))
+ ;; The contents of '.git' vary as a function of the current
+ ;; status of the Git repo. Since we want a fixed output, this
+ ;; directory needs to be taken out.
+ (delete-file-recursively ".git")
+ #t))
;;; git.scm ends here
^ permalink raw reply related [flat|nested] only message in thread
only message in thread, other threads:[~2018-02-13 23:55 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-02-13 23:54 [bug#30450] [PATCH] git-download: Fetch only the required commit, if possible Danny Milosavljevic
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).