summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-03-17 23:59:18 +0100
committerLudovic Courtès <ludo@gnu.org>2018-03-18 00:02:06 +0100
commit95bd9f65a8ee64d17707a76aebc8720bbd961b68 (patch)
tree75e625e308ce3440903effabced85c146972a8b8 /guix
parent44efe67ed0def7b1c246e8705d23f4554b65247f (diff)
git: 'switch-to-ref' accepts short commit IDs.
Fixes <https://bugs.gnu.org/30716>. Reported by Björn Höfling <bjoern.hoefling@bjoernhoefling.de>. * guix/git.scm (switch-to-ref): When REF is a commit, check the length of COMMIT and use 'object-lookup-prefix' if available.
Diffstat (limited to 'guix')
-rw-r--r--guix/git.scm40
1 files changed, 29 insertions, 11 deletions
diff --git a/guix/git.scm b/guix/git.scm
index fc41e2ace3..d31c35f64f 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,6 +28,8 @@
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:export (%repository-cache-directory
latest-repository-commit))
@@ -94,17 +97,32 @@ create the store directory name."
(define (switch-to-ref repository ref)
"Switch to REPOSITORY's branch, commit or tag specified by REF."
- (let* ((oid (match ref
- (('branch . branch)
- (reference-target
- (branch-lookup repository branch BRANCH-REMOTE)))
- (('commit . commit)
- (string->oid commit))
- (('tag . tag)
- (reference-name->oid repository
- (string-append "refs/tags/" tag)))))
- (obj (object-lookup repository oid)))
- (reset repository obj RESET_HARD)))
+ (define obj
+ (match ref
+ (('branch . branch)
+ (let ((oid (reference-target
+ (branch-lookup repository branch BRANCH-REMOTE))))
+ (object-lookup repository oid)))
+ (('commit . commit)
+ (let ((len (string-length commit)))
+ ;; 'object-lookup-prefix' appeared in Guile-Git in Mar. 2018, so we
+ ;; can't be sure it's available. Furthermore, 'string->oid' used to
+ ;; read out-of-bounds when passed a string shorter than 40 chars,
+ ;; which is why we delay calls to it below.
+ (if (< len 40)
+ (if (module-defined? (resolve-interface '(git object))
+ 'object-lookup-prefix)
+ (object-lookup-prefix repository (string->oid commit) len)
+ (raise (condition
+ (&message
+ (message "long Git object ID is required")))))
+ (object-lookup repository (string->oid commit)))))
+ (('tag . tag)
+ (let ((oid (reference-name->oid repository
+ (string-append "refs/tags/" tag))))
+ (object-lookup repository oid)))))
+
+ (reset repository obj RESET_HARD))
(define* (latest-repository-commit store url
#:key