git: Update cached checkout to the remote HEAD by default.
Fixes <https://bugs.gnu.org/45187>. Reported by Ricardo Wurmus <rekado@elephly.net>. update-cached-checkout hard codes "master" as the default branch, leading to a failure when the clone doesn't have a "master" branch. Instead use the remote HEAD symref as an indicator of what the primary branch is. * guix/git.scm (resolve-reference): Support resolving symrefs. (update-cached-checkout, latest-repository-commit): Change the default for REF to the empty list and translate it to the remote HEAD symref. (<git-checkout>): Change branch field's default to #f. (git-checkout-compiler): When branch and commit fields are both #f, call latest-repository-commit* with the empty list as the ref. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
		
							parent
							
								
									d7e57e2a5b
								
							
						
					
					
						commit
						cb41c15827
					
				
					 1 changed files with 16 additions and 7 deletions
				
			
		
							
								
								
									
										23
									
								
								guix/git.scm
									
										
									
									
									
								
							
							
						
						
									
										23
									
								
								guix/git.scm
									
										
									
									
									
								
							|  | @ -1,6 +1,7 @@ | ||||||
| ;;; GNU Guix --- Functional package management for GNU | ;;; GNU Guix --- Functional package management for GNU | ||||||
| ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com> | ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com> | ||||||
| ;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> | ;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> | ||||||
|  | ;;; Copyright © 2021 Kyle Meyer <kyle@kyleam.com> | ||||||
| ;;; | ;;; | ||||||
| ;;; This file is part of GNU Guix. | ;;; This file is part of GNU Guix. | ||||||
| ;;; | ;;; | ||||||
|  | @ -209,6 +210,9 @@ corresponding Git object." | ||||||
|        (let ((oid (reference-target |        (let ((oid (reference-target | ||||||
|                    (branch-lookup repository branch BRANCH-REMOTE)))) |                    (branch-lookup repository branch BRANCH-REMOTE)))) | ||||||
|          (object-lookup repository oid))) |          (object-lookup repository oid))) | ||||||
|  |       (('symref . symref) | ||||||
|  |        (let ((oid (reference-name->oid repository symref))) | ||||||
|  |          (object-lookup repository oid))) | ||||||
|       (('commit . commit) |       (('commit . commit) | ||||||
|        (let ((len (string-length commit))) |        (let ((len (string-length commit))) | ||||||
|          ;; 'object-lookup-prefix' appeared in Guile-Git in Mar. 2018, so we |          ;; 'object-lookup-prefix' appeared in Guile-Git in Mar. 2018, so we | ||||||
|  | @ -340,7 +344,7 @@ definitely available in REPOSITORY, false otherwise." | ||||||
| 
 | 
 | ||||||
| (define* (update-cached-checkout url | (define* (update-cached-checkout url | ||||||
|                                  #:key |                                  #:key | ||||||
|                                  (ref '(branch . "master")) |                                  (ref '()) | ||||||
|                                  recursive? |                                  recursive? | ||||||
|                                  (check-out? #t) |                                  (check-out? #t) | ||||||
|                                  starting-commit |                                  starting-commit | ||||||
|  | @ -356,6 +360,7 @@ provided) as returned by 'commit-relation'. | ||||||
| 
 | 
 | ||||||
| REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value | REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value | ||||||
| the associated data: [<branch name> | <sha1> | <tag name> | <string>]. | the associated data: [<branch name> | <sha1> | <tag name> | <string>]. | ||||||
|  | If REF is the empty list, the remote HEAD is used. | ||||||
| 
 | 
 | ||||||
| When RECURSIVE? is true, check out submodules as well, if any. | When RECURSIVE? is true, check out submodules as well, if any. | ||||||
| 
 | 
 | ||||||
|  | @ -374,6 +379,7 @@ it unchanged." | ||||||
|     ;; made little sense since the cache should be transparent to them.  So |     ;; made little sense since the cache should be transparent to them.  So | ||||||
|     ;; here we append "origin/" if it's missing and otherwise keep it. |     ;; here we append "origin/" if it's missing and otherwise keep it. | ||||||
|     (match ref |     (match ref | ||||||
|  |       (() '(symref . "refs/remotes/origin/HEAD")) | ||||||
|       (('branch . branch) |       (('branch . branch) | ||||||
|        `(branch . ,(if (string-prefix? "origin/" branch) |        `(branch . ,(if (string-prefix? "origin/" branch) | ||||||
|                        branch |                        branch | ||||||
|  | @ -433,12 +439,13 @@ it unchanged." | ||||||
|                                    (log-port (%make-void-port "w")) |                                    (log-port (%make-void-port "w")) | ||||||
|                                    (cache-directory |                                    (cache-directory | ||||||
|                                     (%repository-cache-directory)) |                                     (%repository-cache-directory)) | ||||||
|                                    (ref '(branch . "master"))) |                                    (ref '())) | ||||||
|   "Return two values: the content of the git repository at URL copied into a |   "Return two values: the content of the git repository at URL copied into a | ||||||
| store directory and the sha1 of the top level commit in this directory.  The | store directory and the sha1 of the top level commit in this directory.  The | ||||||
| reference to be checkout, once the repository is fetched, is specified by REF. | reference to be checkout, once the repository is fetched, is specified by REF. | ||||||
| REF is pair whose key is [branch | commit | tag] and value the associated | REF is pair whose key is [branch | commit | tag] and value the associated | ||||||
| data, respectively [<branch name> | <sha1> | <tag name>]. | data, respectively [<branch name> | <sha1> | <tag name>].  If REF is the empty | ||||||
|  | list, the remote HEAD is used. | ||||||
| 
 | 
 | ||||||
| When RECURSIVE? is true, check out submodules as well, if any. | When RECURSIVE? is true, check out submodules as well, if any. | ||||||
| 
 | 
 | ||||||
|  | @ -548,7 +555,7 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or | ||||||
|   git-checkout make-git-checkout |   git-checkout make-git-checkout | ||||||
|   git-checkout? |   git-checkout? | ||||||
|   (url     git-checkout-url) |   (url     git-checkout-url) | ||||||
|   (branch  git-checkout-branch (default "master")) |   (branch  git-checkout-branch (default #f)) | ||||||
|   (commit  git-checkout-commit (default #f))      ;#f | tag | commit |   (commit  git-checkout-commit (default #f))      ;#f | tag | commit | ||||||
|   (recursive? git-checkout-recursive? (default #f))) |   (recursive? git-checkout-recursive? (default #f))) | ||||||
| 
 | 
 | ||||||
|  | @ -587,9 +594,11 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or | ||||||
|   (match checkout |   (match checkout | ||||||
|     (($ <git-checkout> url branch commit recursive?) |     (($ <git-checkout> url branch commit recursive?) | ||||||
|      (latest-repository-commit* url |      (latest-repository-commit* url | ||||||
|                                 #:ref (if commit |                                 #:ref (cond (commit | ||||||
|                                           `(tag-or-commit . ,commit) |                                              `(tag-or-commit . ,commit)) | ||||||
|                                           `(branch . ,branch)) |                                             (branch | ||||||
|  |                                              `(branch . ,branch)) | ||||||
|  |                                             (else '())) | ||||||
|                                 #:recursive? recursive? |                                 #:recursive? recursive? | ||||||
|                                 #:log-port (current-error-port))))) |                                 #:log-port (current-error-port))))) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
		Reference in a new issue