Merge branch 'master' into core-updates

1 files changed, 52 insertions, 13 deletions

diff --git a/guix/git.scm b/guix/git.scm
index 92121156cf..0d8e617cc9 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -39,10 +39,12 @@
             honor-system-x509-certificates!
 
             with-repository
+            false-if-git-not-found
             update-cached-checkout
             url+commit->name
             latest-repository-commit
             commit-difference
+            commit-relation
 
             git-checkout
             git-checkout?
@@ -242,18 +244,23 @@ Return true on success, false on failure."
               (G_ "Support for submodules is missing; \
 please upgrade Guile-Git.~%"))))
 
+(define-syntax-rule (false-if-git-not-found exp)
+  "Evaluate EXP, returning #false if a GIT_ENOTFOUND error is raised."
+  (catch 'git-error
+    (lambda ()
+      exp)
+    (lambda (key error . rest)
+      (if (= GIT_ENOTFOUND (git-error-code error))
+          #f
+          (apply throw key error rest)))))
+
 (define (reference-available? repository ref)
   "Return true if REF, a reference such as '(commit . \"cabba9e\"), is
 definitely available in REPOSITORY, false otherwise."
   (match ref
     (('commit . commit)
-     (catch 'git-error
-       (lambda ()
-         (->bool (commit-lookup repository (string->oid commit))))
-       (lambda (key error . rest)
-         (if (= GIT_ENOTFOUND (git-error-code error))
-             #f
-             (apply throw key error rest)))))
+     (false-if-git-not-found
+      (->bool (commit-lookup repository (string->oid commit)))))
     (_
      #f)))
 
@@ -261,14 +268,16 @@ definitely available in REPOSITORY, false otherwise."
                                  #:key
                                  (ref '(branch . "master"))
                                  recursive?
+                                 starting-commit
                                  (log-port (%make-void-port "w"))
                                  (cache-directory
                                   (url-cache-directory
                                    url (%repository-cache-directory)
                                    #:recursive? recursive?)))
-  "Update the cached checkout of URL to REF in CACHE-DIRECTORY.  Return two
+  "Update the cached checkout of URL to REF in CACHE-DIRECTORY.  Return three
 values: the cache directory name, and the SHA1 commit (a string) corresponding
-to REF.
+to REF, and the relation of the new commit relative to STARTING-COMMIT (if
+provided) as returned by 'commit-relation'.
 
 REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value
 the associated data: [<branch name> | <sha1> | <tag name> | <string>].
@@ -301,7 +310,20 @@ When RECURSIVE? is true, check out submodules as well, if any."
            (remote-fetch (remote-lookup repository "origin"))))
      (when recursive?
        (update-submodules repository #:log-port log-port))
-     (let ((oid (switch-to-ref repository canonical-ref)))
+
+     ;; Note: call 'commit-relation' from here because it's more efficient
+     ;; than letting users re-open the checkout later on.
+     (let* ((oid      (switch-to-ref repository canonical-ref))
+            (new      (and starting-commit
+                           (commit-lookup repository oid)))
+            (old      (and starting-commit
+                           (false-if-git-not-found
+                            (commit-lookup repository
+                                           (string->oid starting-commit)))))
+            (relation (and starting-commit
+                           (if old
+                               (commit-relation old new)
+                               'unrelated))))
 
        ;; Reclaim file descriptors and memory mappings associated with
        ;; REPOSITORY as soon as possible.
@@ -309,7 +331,7 @@ When RECURSIVE? is true, check out submodules as well, if any."
                               'repository-close!)
          (repository-close! repository))
 
-       (values cache-directory (oid->string oid))))))
+       (values cache-directory (oid->string oid) relation)))))
 
 (define* (latest-repository-commit store url
                                    #:key
@@ -342,7 +364,7 @@ Log progress and checkout info to LOG-PORT."
 
   (format log-port "updating checkout of '~a'...~%" url)
   (let*-values
-      (((checkout commit)
+      (((checkout commit _)
         (update-cached-checkout url
                                 #:recursive? recursive?
                                 #:ref ref
@@ -394,7 +416,9 @@ Essentially, this computes the set difference between the closure of NEW and
 that of OLD."
   (let loop ((commits (list new))
              (result '())
-             (visited (commit-closure old (list->setq excluded))))
+             (visited (fold commit-closure
+                            (setq)
+                            (cons old excluded))))
     (match commits
       (()
        (reverse result))
@@ -405,6 +429,21 @@ that of OLD."
                  (cons head result)
                  (set-insert head visited)))))))
 
+(define (commit-relation 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))))))
+
 
 ;;;
 ;;; Checkouts.