nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2018-03-17 23:59:18 +01:00
parent 44efe67ed0
commit 95bd9f65a8
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 29 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
guix/git.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -27,6 +28,8 @@
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:export (%repository-cache-directory #:export (%repository-cache-directory
latest-repository-commit)) latest-repository-commit))
@ -94,17 +97,32 @@ create the store directory name."
(define (switch-to-ref repository ref) (define (switch-to-ref repository ref)
"Switch to REPOSITORY's branch, commit or tag specified by REF." "Switch to REPOSITORY's branch, commit or tag specified by REF."
(let* ((oid (match ref (define obj
(('branch . branch) (match ref
(reference-target (('branch . branch)
(branch-lookup repository branch BRANCH-REMOTE))) (let ((oid (reference-target
(('commit . commit) (branch-lookup repository branch BRANCH-REMOTE))))
(string->oid commit)) (object-lookup repository oid)))
(('tag . tag) (('commit . commit)
(reference-name->oid repository (let ((len (string-length commit)))
(string-append "refs/tags/" tag))))) ;; 'object-lookup-prefix' appeared in Guile-Git in Mar. 2018, so we
(obj (object-lookup repository oid))) ;; can't be sure it's available. Furthermore, 'string->oid' used to
(reset repository obj RESET_HARD))) ;; 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 (define* (latest-repository-commit store url
#:key #:key