From ddd455c0dd5a527f3c7e94b8b9056155facb37e6 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 20 Feb 2024 16:52:34 +0100
Subject: swh: ‘lookup-origin-revision’ handles branches pointing to
 directories.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Fixes <https://issues.guix.gnu.org/69070>.

* guix/swh.scm (branch-target): Add clause for 'directory and 'alias.
(lookup-origin-revision): Iterate over all the visits of ORIGIN instead
of just the first one.  Handle the case where ‘branch-target’ returns
something other than a release or revision.
* tests/swh.scm ("lookup-origin-revision"): New test.

Change-Id: I7f636739a719908763bca1d3e7376341dd62e816
---
 tests/swh.scm | 74 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 74 insertions(+)

(limited to 'tests')

diff --git a/tests/swh.scm b/tests/swh.scm
index e7ced6b50c..11dcbdddd8 100644
--- a/tests/swh.scm
+++ b/tests/swh.scm
@@ -109,6 +109,80 @@ (define-syntax-rule (with-json-result str exp ...)
                  (directory-entry-length entry)))
          (lookup-directory "123"))))
 
+(test-equal "lookup-origin-revision"
+  '("cd86c72084993d9ef26fc9e24b73cea612b8c97b"
+    "d173c707ee88e3c89401ad77fafa65fcd9e9f5be")
+  (let ()
+    ;; Make sure that 'lookup-origin-revision' does the job, and in particular
+    ;; that it doesn't stop until it has found an actual revision:
+    ;; 'git-checkout visits point to directories instead of revisions.
+    ;; See <https://issues.guix.gnu.org/69070>.
+    (define visits
+      ;; Two visits of differing types: the first visit (type 'git-checkout')
+      ;; points to a directory, the second one (type 'git') points to a
+      ;; revision.
+      "[ {
+    \"origin\": \"https://example.org/repo.git\",
+    \"visit\": 1,
+    \"type\": \"git-checkout\",
+    \"date\": \"2020-05-17T21:43:45.422977+00:00\",
+    \"status\": \"full\",
+    \"metadata\": {},
+    \"type\": \"git-checkout\",
+    \"origin_visit_url\": \"/visit/42\",
+    \"snapshot_url\": \"/snapshot/1\"
+  }, {
+    \"origin\": \"https://example.org/repo.git\",
+    \"visit\": 2,
+    \"type\": \"git\",
+    \"date\": \"2020-05-17T21:43:49.422977+00:00\",
+    \"status\": \"full\",
+    \"metadata\": {},
+    \"type\": \"git\",
+    \"origin_visit_url\": \"/visit/41\",
+    \"snapshot_url\": \"/snapshot/2\"
+  } ]")
+    (define snapshot-for-git-checkout
+      "{ \"id\": 42,
+         \"branches\": { \"1.3.2\": {
+           \"target\": \"e4a4be18fae8d9c6528abff3bc9088feb19a76c7\",
+           \"target_type\": \"directory\",
+           \"target_url\": \"/directory/e4a4be18fae8d9c6528abff3bc9088feb19a76c7\"
+         }}
+       }")
+    (define snapshot-for-git
+      "{ \"id\": 42,
+         \"branches\": { \"1.3.2\": {
+           \"target\": \"e4a4be18fae8d9c6528abff3bc9088feb19a76c7\",
+           \"target_type\": \"revision\",
+           \"target_url\": \"/revision/e4a4be18fae8d9c6528abff3bc9088feb19a76c7\"
+         }}
+       }")
+    (define revision
+      "{ \"author\": {},
+         \"committer\": {},
+         \"committer_date\": \"2018-05-17T21:43:49.422977+00:00\",
+         \"date\": \"2018-05-17T21:43:49.422977+00:00\",
+         \"directory\": \"d173c707ee88e3c89401ad77fafa65fcd9e9f5be\",
+         \"directory_url\": \"/directory/d173c707ee88e3c89401ad77fafa65fcd9e9f5be\",
+         \"id\": \"cd86c72084993d9ef26fc9e24b73cea612b8c97b\",
+         \"merge\": false,
+         \"message\": \"Fix.\",
+         \"parents\": [],
+         \"type\": \"what type?\"
+       }")
+
+    (with-http-server `((200 ,%origin)
+                        (200 ,visits)
+                        (200 ,snapshot-for-git-checkout)
+                        (200 ,snapshot-for-git)
+                        (200 ,revision))
+      (parameterize ((%swh-base-url (%local-url)))
+        (let ((revision (lookup-origin-revision "https://example.org/repo.git"
+                                                "1.3.2")))
+          (list (revision-id revision)
+                (revision-directory revision)))))))
+
 (test-equal "lookup-directory-by-nar-hash"
   "swh:1:dir:84a8b34591712c0a90bab0af604188bcd1fe3153"
   (with-json-result %external-id
-- 
cgit v1.2.3