[bug#77875,v2,1/2] git: Use ‘graph-descendant?’ from Guile-Git >= 0.10.0 when available.
Commit Message
Fixes <https://issues.guix.gnu.org/66268>.
Fixes a bug whereby ‘commit-relation’ and ‘commit-descendant?’ would
provide an incorrect result when two distinct <commit> objects would
exist for the same commit, which happens when the commit’s metadata is
beyond 4 KiB at least as of libgit2 1.8/1.9.
This, in turn, would lead ‘guix pull’ & co. to wrongfully report an
attempt to downgrade and pull to an unrelated commit.
* guix/git.scm (commit-relation): When (guix graph) is available,
rewrite in terms of ‘graph-descendant?’.
(commit-descendant?): Likewise.
Change-Id: Ie52b188a8dfa90c95a73387c3ab2fdd04d2bf3e9
Reported-by: Tomas Volf <~@wolfsden.cz>
---
guix/git.scm | 83 ++++++++++++++++++++++++++++++++--------------------
1 file changed, 52 insertions(+), 31 deletions(-)
Comments
Ludovic Courtès <ludo@gnu.org> writes:
> Fixes <https://issues.guix.gnu.org/66268>.
>
> Fixes a bug whereby ‘commit-relation’ and ‘commit-descendant?’ would
> provide an incorrect result when two distinct <commit> objects would
> exist for the same commit, which happens when the commit’s metadata is
> beyond 4 KiB at least as of libgit2 1.8/1.9.
>
> This, in turn, would lead ‘guix pull’ & co. to wrongfully report an
> attempt to downgrade and pull to an unrelated commit.
>
> * guix/git.scm (commit-relation): When (guix graph) is available,
You forgot to switch to (git graph) here.
> rewrite in terms of ‘graph-descendant?’.
> (commit-descendant?): Likewise.
>
> Change-Id: Ie52b188a8dfa90c95a73387c3ab2fdd04d2bf3e9
> Reported-by: Tomas Volf <~@wolfsden.cz>
> ---
> guix/git.scm | 83 ++++++++++++++++++++++++++++++++--------------------
> 1 file changed, 52 insertions(+), 31 deletions(-)
>
> diff --git a/guix/git.scm b/guix/git.scm
> index 01e0918588..1065479091 100644
> --- a/guix/git.scm
> +++ b/guix/git.scm
> @@ -732,7 +732,7 @@ (define (print-git-error port key args default-printer)
> ;;; Commit difference.
> ;;;
>
> -(define* (commit-closure commit #:optional (visited (setq)))
> +(define* (commit-closure commit #:optional (visited (setq))) ;to remove
> "Return the closure of COMMIT as a set. Skip commits contained in VISITED,
> a set, and adjoin VISITED to the result."
> (let loop ((commits (list commit))
> @@ -768,39 +768,60 @@ (define* (commit-difference new old #:optional (excluded '()))
> (cons head result)
> (set-insert head visited)))))))
>
> -(define (commit-relation old new)
> - "Return a symbol denoting the relation between OLD and NEW, two commit
> +(define commit-relation
> + (if (resolve-module '(git graph) #:ensure #f) ;Guile-Git >= 0.10.0
> + (lambda (old new)
> + "Return a symbol denoting the relation between OLD and NEW, two commit
> objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
> 'unrelated, or 'self (OLD and NEW are the same commit)."
> - (if (eq? old new)
> - 'self
> - (let ((newest (commit-closure new)))
> - (if (set-contains? newest old)
> - 'ancestor
> - (let* ((seen (list->setq (commit-parents new)))
> - (oldest (commit-closure old seen)))
> - (if (set-contains? oldest new)
> - 'descendant
> - 'unrelated))))))
> + (let ((repository (commit-owner old))
> + (old (commit-id old))
> + (new (commit-id new)))
> + (cond ((graph-descendant? repository new old)
> + 'ancestor)
> + ((oid=? old new)
> + 'self)
> + ((graph-descendant? repository old new)
> + 'descendant)
> + (else 'unrelated))))
> + (lambda (old new) ;remove when Guile-Git 0.10.0 is widespread
> + (if (eq? old new)
> + 'self
> + (let ((newest (commit-closure new)))
> + (if (set-contains? newest old)
> + 'ancestor
> + (let* ((seen (list->setq (commit-parents new)))
> + (oldest (commit-closure old seen)))
> + (if (set-contains? oldest new)
> + 'descendant
> + 'unrelated))))))))
>
> -(define (commit-descendant? new old)
> - "Return true if NEW is the descendant of one of OLD, a list of commits.
> -
> -When the expected result is likely #t, this is faster than using
> -'commit-relation' since fewer commits need to be traversed."
> - (let ((old (list->setq old)))
> - (let loop ((commits (list new))
> - (visited (setq)))
> - (match commits
> - (()
> - #f)
> - (_
> - ;; Perform a breadth-first search as this is likely going to
> - ;; terminate more quickly than a depth-first search.
> - (let ((commits (remove (cut set-contains? visited <>) commits)))
> - (or (any (cut set-contains? old <>) commits)
> - (loop (append-map commit-parents commits)
> - (fold set-insert visited commits)))))))))
> +(define commit-descendant?
> + (if (resolve-module '(git graph) #:ensure #f) ;Guile-Git >= 0.10.0
> + (lambda (new old)
> + "Return true if NEW is the descendant of one of OLD, a list of
> +commits."
> + (let ((repository (commit-owner new))
> + (new (commit-id new)))
> + (any (lambda (old)
> + (let ((old (commit-id old)))
> + (or (graph-descendant? repository new old)
> + (oid=? old new))))
> + old)))
> + (lambda (new old) ;remove when Guile-Git 0.10.0 is widespread
> + (let ((old (list->setq old)))
> + (let loop ((commits (list new))
> + (visited (setq)))
> + (match commits
> + (()
> + #f)
> + (_
> + ;; Perform a breadth-first search as this is likely going to
> + ;; terminate more quickly than a depth-first search.
> + (let ((commits (remove (cut set-contains? visited <>) commits)))
> + (or (any (cut set-contains? old <>) commits)
> + (loop (append-map commit-parents commits)
> + (fold set-insert visited commits)))))))))))
>
>
> ;;
Other then the commit message looks good.
Reviewed-by: Tomas Volf <~@wolfsden.cz>
Tomas Volf <~@wolfsden.cz> writes:
> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Fixes <https://issues.guix.gnu.org/66268>.
>>
>> Fixes a bug whereby ‘commit-relation’ and ‘commit-descendant?’ would
>> provide an incorrect result when two distinct <commit> objects would
>> exist for the same commit, which happens when the commit’s metadata is
>> beyond 4 KiB at least as of libgit2 1.8/1.9.
>>
>> This, in turn, would lead ‘guix pull’ & co. to wrongfully report an
>> attempt to downgrade and pull to an unrelated commit.
>>
>> * guix/git.scm (commit-relation): When (guix graph) is available,
>
> You forgot to switch to (git graph) here.
Oops. Fixed and pushed as ee6d2a77a3f07c4b81fd31bc7aa5d07accc317bd.
Thanks,
Ludo’.
@@ -732,7 +732,7 @@ (define (print-git-error port key args default-printer)
;;; Commit difference.
;;;
-(define* (commit-closure commit #:optional (visited (setq)))
+(define* (commit-closure commit #:optional (visited (setq))) ;to remove
"Return the closure of COMMIT as a set. Skip commits contained in VISITED,
a set, and adjoin VISITED to the result."
(let loop ((commits (list commit))
@@ -768,39 +768,60 @@ (define* (commit-difference new old #:optional (excluded '()))
(cons head result)
(set-insert head visited)))))))
-(define (commit-relation old new)
- "Return a symbol denoting the relation between OLD and NEW, two commit
+(define commit-relation
+ (if (resolve-module '(git graph) #:ensure #f) ;Guile-Git >= 0.10.0
+ (lambda (old new)
+ "Return a symbol denoting the relation between OLD and NEW, two commit
objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
'unrelated, or 'self (OLD and NEW are the same commit)."
- (if (eq? old new)
- 'self
- (let ((newest (commit-closure new)))
- (if (set-contains? newest old)
- 'ancestor
- (let* ((seen (list->setq (commit-parents new)))
- (oldest (commit-closure old seen)))
- (if (set-contains? oldest new)
- 'descendant
- 'unrelated))))))
+ (let ((repository (commit-owner old))
+ (old (commit-id old))
+ (new (commit-id new)))
+ (cond ((graph-descendant? repository new old)
+ 'ancestor)
+ ((oid=? old new)
+ 'self)
+ ((graph-descendant? repository old new)
+ 'descendant)
+ (else 'unrelated))))
+ (lambda (old new) ;remove when Guile-Git 0.10.0 is widespread
+ (if (eq? old new)
+ 'self
+ (let ((newest (commit-closure new)))
+ (if (set-contains? newest old)
+ 'ancestor
+ (let* ((seen (list->setq (commit-parents new)))
+ (oldest (commit-closure old seen)))
+ (if (set-contains? oldest new)
+ 'descendant
+ 'unrelated))))))))
-(define (commit-descendant? new old)
- "Return true if NEW is the descendant of one of OLD, a list of commits.
-
-When the expected result is likely #t, this is faster than using
-'commit-relation' since fewer commits need to be traversed."
- (let ((old (list->setq old)))
- (let loop ((commits (list new))
- (visited (setq)))
- (match commits
- (()
- #f)
- (_
- ;; Perform a breadth-first search as this is likely going to
- ;; terminate more quickly than a depth-first search.
- (let ((commits (remove (cut set-contains? visited <>) commits)))
- (or (any (cut set-contains? old <>) commits)
- (loop (append-map commit-parents commits)
- (fold set-insert visited commits)))))))))
+(define commit-descendant?
+ (if (resolve-module '(git graph) #:ensure #f) ;Guile-Git >= 0.10.0
+ (lambda (new old)
+ "Return true if NEW is the descendant of one of OLD, a list of
+commits."
+ (let ((repository (commit-owner new))
+ (new (commit-id new)))
+ (any (lambda (old)
+ (let ((old (commit-id old)))
+ (or (graph-descendant? repository new old)
+ (oid=? old new))))
+ old)))
+ (lambda (new old) ;remove when Guile-Git 0.10.0 is widespread
+ (let ((old (list->setq old)))
+ (let loop ((commits (list new))
+ (visited (setq)))
+ (match commits
+ (()
+ #f)
+ (_
+ ;; Perform a breadth-first search as this is likely going to
+ ;; terminate more quickly than a depth-first search.
+ (let ((commits (remove (cut set-contains? visited <>) commits)))
+ (or (any (cut set-contains? old <>) commits)
+ (loop (append-map commit-parents commits)
+ (fold set-insert visited commits)))))))))))
;;