[bug#77875] [PATCH v2 1/2] git: Use ‘graph-descendant?’ from Guile-Git >= 0.10.0 when available.

[Tomas Volf]

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>

-- 
There are only two hard things in Computer Science:
cache invalidation, naming things and off-by-one errors.