diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-09-14 11:11:54 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-09-14 11:23:08 +0200 |
| commit | 13512e1b8f63b4d8fcb188fac992aa390149fe65 (patch) | |
| tree | c8e4db9f9f9f4991613bcedb12a472843ff0a9f7 /guix | |
| parent | daa6036fda502460f626b7beb0afa93a0bac6d01 (diff) | |
| download | gnu-guix-13512e1b8f63b4d8fcb188fac992aa390149fe65.tar gnu-guix-13512e1b8f63b4d8fcb188fac992aa390149fe65.tar.gz | |
git-download: 'git-predicate' returns #f on Git errors.
Fixes a regression introduced in
aed0a594058a59bc3bb1d2686391dc0e8a181b1f whereby 'git-predicate' would
throw to 'git-error instead of returning #f as the docstring says.
* guix/git-download.scm (git-predicate): Return #f upon 'git-error'.
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/git-download.scm | 36 |
1 files changed, 20 insertions, 16 deletions
diff --git a/guix/git-download.scm b/guix/git-download.scm index e6e0ec2ac5..24cf11be5e 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -179,24 +179,28 @@ are relative to DIRECTORY, which is not necessarily the root of the checkout." (define (git-predicate directory) "Return a predicate that returns true if a file is part of the Git checkout -living at DIRECTORY. Upon Git failure, return #f instead of a predicate. +living at DIRECTORY. If DIRECTORY does not lie within a Git checkout, and +upon Git errors, return #f instead of a predicate. The returned predicate takes two arguments FILE and STAT where FILE is an absolute file name and STAT is the result of 'lstat'." - (let* ((files (git-file-list directory)) - (inodes (fold (lambda (file result) - (let ((stat - (lstat (string-append directory "/" - file)))) - (vhash-consv (stat:ino stat) (stat:dev stat) - result))) - vlist-null - files))) - (lambda (file stat) - ;; Comparing file names is always tricky business so we rely on inode - ;; numbers instead. - (match (vhash-assv (stat:ino stat) inodes) - ((_ . dev) (= dev (stat:dev stat))) - (#f #f))))) + (catch 'git-error + (lambda () + (let* ((files (git-file-list directory)) + (inodes (fold (lambda (file result) + (let ((stat + (lstat (string-append directory "/" + file)))) + (vhash-consv (stat:ino stat) (stat:dev stat) + result))) + vlist-null + files))) + (lambda (file stat) + ;; Comparing file names is always tricky business so we rely on inode + ;; numbers instead. + (match (vhash-assv (stat:ino stat) inodes) + ((_ . dev) (= dev (stat:dev stat))) + (#f #f))))) + (const #f))) ;;; git-download.scm ends here |