git-download: 'git-fetch' really returns #f upon error.
This allows the fallback code in (guix git-download) to actually run.
Regression introduced in commit 329dabe13b
.
Fixes <https://bugs.gnu.org/33911>.
Reported by Björn Höfling <bjoern.hoefling@bjoernhoefling.de>.
* guix/build/git.scm (git-fetch): Guard against 'invoke-error?' and
really return #f upon failure.
master
parent
210e43c762
commit
18524466bb
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2014, 2016, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -18,6 +18,8 @@
|
||||||
|
|
||||||
(define-module (guix build git)
|
(define-module (guix build git)
|
||||||
#:use-module (guix build utils)
|
#:use-module (guix build utils)
|
||||||
|
#:use-module (srfi srfi-34)
|
||||||
|
#:use-module (ice-9 format)
|
||||||
#:export (git-fetch))
|
#:export (git-fetch))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
|
@ -39,6 +41,16 @@ recursively. Return #t on success, #f otherwise."
|
||||||
|
|
||||||
(mkdir-p directory)
|
(mkdir-p directory)
|
||||||
|
|
||||||
|
(guard (c ((invoke-error? c)
|
||||||
|
(format (current-error-port)
|
||||||
|
"git-fetch: '~a~{ ~a~}' failed with exit code ~a~%"
|
||||||
|
(invoke-error-program c)
|
||||||
|
(invoke-error-arguments c)
|
||||||
|
(or (invoke-error-exit-status c) ;XXX: not quite accurate
|
||||||
|
(invoke-error-stop-signal c)
|
||||||
|
(invoke-error-term-signal c)))
|
||||||
|
(delete-file-recursively directory)
|
||||||
|
#f))
|
||||||
(with-directory-excursion directory
|
(with-directory-excursion directory
|
||||||
(invoke git-command "init")
|
(invoke git-command "init")
|
||||||
(invoke git-command "remote" "add" "origin" url)
|
(invoke git-command "remote" "add" "origin" url)
|
||||||
|
@ -64,6 +76,6 @@ recursively. Return #t on success, #f otherwise."
|
||||||
;; status of the Git repo. Since we want a fixed output, this
|
;; status of the Git repo. Since we want a fixed output, this
|
||||||
;; directory needs to be taken out.
|
;; directory needs to be taken out.
|
||||||
(delete-file-recursively ".git")
|
(delete-file-recursively ".git")
|
||||||
#t))
|
#t)))
|
||||||
|
|
||||||
;;; git.scm ends here
|
;;; git.scm ends here
|
||||||
|
|
Reference in New Issue