ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

git: 'switch-to-ref' accepts short commit IDs.

Browse source 
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

34
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 @@ (define-module (guix git)
#: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 @@ (define (dot-git? file stat)
(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
(match ref
(('branch . branch) (('branch . branch)
(reference-target (let ((oid (reference-target
(branch-lookup repository branch BRANCH-REMOTE))) (branch-lookup repository branch BRANCH-REMOTE))))
(object-lookup repository oid)))
(('commit . commit) (('commit . commit)
(string->oid 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) (('tag . tag)
(reference-name->oid repository (let ((oid (reference-name->oid repository
(string-append "refs/tags/" tag))))) (string-append "refs/tags/" tag))))
(obj (object-lookup repository oid))) (object-lookup repository oid)))))
(reset repository obj RESET_HARD)))
(reset repository obj RESET_HARD))
(define* (latest-repository-commit store url (define* (latest-repository-commit store url
#:key #:key