diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-06-07 22:14:56 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-06-07 23:10:46 +0200 |
| commit | 1fd7de45f218ce572a3fe87764ad15927e3dbdc4 (patch) | |
| tree | 403fdff74a8d91fec1b595e203af7b294ff23d4f | |
| parent | 715f589ea39146fa66cce5470c0368073c471540 (diff) | |
git: 'update-cached-checkout' gracefully handles missing starting commit.
Fixes <https://bugs.gnu.org/41604>
Reported by John Soo <jsoo1@asu.edu> and zimoun <zimon.toutoune@gmail.com>.
* guix/git.scm (false-if-git-not-found): New macro.
(reference-available?): Use it.
(update-cached-checkout): Use it when looking up STARTING-COMMIT.
Set RELATION to 'unrelated when OLD is #false.
| -rw-r--r-- | guix/git.scm | 28 |
1 files changed, 18 insertions, 10 deletions
diff --git a/guix/git.scm b/guix/git.scm index ab3b5075b18..1c45afa050d 100644 --- a/guix/git.scm +++ b/guix/git.scm | |||
| @@ -243,18 +243,23 @@ Return true on success, false on failure." | |||
| 243 | (G_ "Support for submodules is missing; \ | 243 | (G_ "Support for submodules is missing; \ |
| 244 | please upgrade Guile-Git.~%")))) | 244 | please upgrade Guile-Git.~%")))) |
| 245 | 245 | ||
| 246 | (define-syntax-rule (false-if-git-not-found exp) | ||
| 247 | "Evaluate EXP, returning #false if a GIT_ENOTFOUND error is raised." | ||
| 248 | (catch 'git-error | ||
| 249 | (lambda () | ||
| 250 | exp) | ||
| 251 | (lambda (key error . rest) | ||
| 252 | (if (= GIT_ENOTFOUND (git-error-code error)) | ||
| 253 | #f | ||
| 254 | (apply throw key error rest))))) | ||
| 255 | |||
| 246 | (define (reference-available? repository ref) | 256 | (define (reference-available? repository ref) |
| 247 | "Return true if REF, a reference such as '(commit . \"cabba9e\"), is | 257 | "Return true if REF, a reference such as '(commit . \"cabba9e\"), is |
| 248 | definitely available in REPOSITORY, false otherwise." | 258 | definitely available in REPOSITORY, false otherwise." |
| 249 | (match ref | 259 | (match ref |
| 250 | (('commit . commit) | 260 | (('commit . commit) |
| 251 | (catch 'git-error | 261 | (false-if-git-not-found |
| 252 | (lambda () | 262 | (->bool (commit-lookup repository (string->oid commit))))) |
| 253 | (->bool (commit-lookup repository (string->oid commit)))) | ||
| 254 | (lambda (key error . rest) | ||
| 255 | (if (= GIT_ENOTFOUND (git-error-code error)) | ||
| 256 | #f | ||
| 257 | (apply throw key error rest))))) | ||
| 258 | (_ | 263 | (_ |
| 259 | #f))) | 264 | #f))) |
| 260 | 265 | ||
| @@ -311,10 +316,13 @@ When RECURSIVE? is true, check out submodules as well, if any." | |||
| 311 | (new (and starting-commit | 316 | (new (and starting-commit |
| 312 | (commit-lookup repository oid))) | 317 | (commit-lookup repository oid))) |
| 313 | (old (and starting-commit | 318 | (old (and starting-commit |
| 314 | (commit-lookup repository | 319 | (false-if-git-not-found |
| 315 | (string->oid starting-commit)))) | 320 | (commit-lookup repository |
| 321 | (string->oid starting-commit))))) | ||
| 316 | (relation (and starting-commit | 322 | (relation (and starting-commit |
| 317 | (commit-relation old new)))) | 323 | (if old |
| 324 | (commit-relation old new) | ||
| 325 | 'unrelated)))) | ||
| 318 | 326 | ||
| 319 | ;; Reclaim file descriptors and memory mappings associated with | 327 | ;; Reclaim file descriptors and memory mappings associated with |
| 320 | ;; REPOSITORY as soon as possible. | 328 | ;; REPOSITORY as soon as possible. |
