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

Message ID 2d335f155de9f667b08393a4e9e8ffa41e03d201.1745270691.git.ludo@gnu.org
State New
Headers
Series Use 'graph-descendant?' from Guile-Git instead of custom code |

Commit Message

Ludovic Courtès April 21, 2025, 9:26 p.m. UTC
  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

Tomas Volf April 22, 2025, 4:51 p.m. UTC | #1
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>
  
Ludovic Courtès April 23, 2025, 10:30 a.m. UTC | #2
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’.
  

Patch

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)))))))))))
 
 
 ;;